Commit 867edb0b by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[Ada] Crash due to missing freeze nodes in transient scope

The following patch updates the freezing of expressions to insert the
generated freeze nodes prior to the expression that produced them when
the context is a transient scope within a type initialization procedure.
This ensures that the nodes are properly interleaved with respect to the
constructs that generated them.

2019-07-01  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* freeze.adb (Freeze_Expression): Remove the horrible useless
	name hiding of N. Insert the freeze nodes generated by the
	expression prior to the expression when the nearest enclosing
	scope is transient.

gcc/testsuite/

	* gnat.dg/freezing1.adb, gnat.dg/freezing1.ads,
	gnat.dg/freezing1_pack.adb, gnat.dg/freezing1_pack.ads: New
	testcase.

From-SVN: r272854
parent 7b3a8d34
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
* freeze.adb (Freeze_Expression): Remove the horrible useless
name hiding of N. Insert the freeze nodes generated by the
expression prior to the expression when the nearest enclosing
scope is transient.
2019-07-01 Pierre-Marie de Rodat <derodat@adacore.com> 2019-07-01 Pierre-Marie de Rodat <derodat@adacore.com>
* doc/gnat_ugn/building_executable_programs_with_gnat.rst: Fix * doc/gnat_ugn/building_executable_programs_with_gnat.rst: Fix
......
...@@ -7665,9 +7665,8 @@ package body Freeze is ...@@ -7665,9 +7665,8 @@ package body Freeze is
or else Ekind (Current_Scope) = E_Void or else Ekind (Current_Scope) = E_Void
then then
declare declare
N : constant Node_Id := Current_Scope; Freeze_Nodes : List_Id := No_List;
Freeze_Nodes : List_Id := No_List; Pos : Int := Scope_Stack.Last;
Pos : Int := Scope_Stack.Last;
begin begin
if Present (Desig_Typ) then if Present (Desig_Typ) then
...@@ -7700,7 +7699,19 @@ package body Freeze is ...@@ -7700,7 +7699,19 @@ package body Freeze is
end if; end if;
if Is_Non_Empty_List (Freeze_Nodes) then if Is_Non_Empty_List (Freeze_Nodes) then
if No (Scope_Stack.Table (Pos).Pending_Freeze_Actions) then
-- When the current scope is transient, insert the freeze nodes
-- prior to the expression that produced them. Transient scopes
-- may create additional declarations when finalizing objects
-- or managing the secondary stack. Inserting the freeze nodes
-- of those constructs prior to the scope would result in a
-- freeze-before-declaration, therefore the freeze node must
-- remain interleaved with their constructs.
if Scope_Is_Transient then
Insert_Actions (N, Freeze_Nodes);
elsif No (Scope_Stack.Table (Pos).Pending_Freeze_Actions) then
Scope_Stack.Table (Pos).Pending_Freeze_Actions := Scope_Stack.Table (Pos).Pending_Freeze_Actions :=
Freeze_Nodes; Freeze_Nodes;
else else
......
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
* gnat.dg/freezing1.adb, gnat.dg/freezing1.ads,
gnat.dg/freezing1_pack.adb, gnat.dg/freezing1_pack.ads: New
testcase.
2019-07-01 Jan Hubicka <hubicka@ucw.cz> 2019-07-01 Jan Hubicka <hubicka@ucw.cz>
PR lto/91028 PR lto/91028
......
-- { dg-do compile }
package body Freezing1 is
procedure Foo is null;
end Freezing1;
with Freezing1_Pack; use Freezing1_Pack;
package Freezing1 is
type T is abstract tagged record
Collection : access I_Interface_Collection'Class :=
new I_Interface_Collection'Class'(Factory.Create_Collection);
end record;
procedure Foo;
end Freezing1;
package body Freezing1_Pack is
function Create_Collection
(Factory : in T_Factory) return I_Interface_Collection'Class
is
begin
return Implem'(null record);
end Create_Collection;
end Freezing1_Pack;
package Freezing1_Pack is
type T_Factory is abstract tagged private;
type I_Interface_Collection is interface;
Factory : constant T_Factory;
function Create_Collection
(Factory : in T_Factory) return I_Interface_Collection'Class;
type Implem is new I_Interface_Collection with null record;
private
type T_Factory is tagged null record;
Factory : constant T_Factory := T_Factory'(null record);
end Freezing1_Pack;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment