From 867edb0b613898bec9128e1ecb055c3277e34dbc Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Mon, 1 Jul 2019 13:34:25 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/freeze.adb | 19 +++++++++++++++---- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gnat.dg/freezing1.adb | 5 +++++ gcc/testsuite/gnat.dg/freezing1.ads | 10 ++++++++++ gcc/testsuite/gnat.dg/freezing1_pack.adb | 8 ++++++++ gcc/testsuite/gnat.dg/freezing1_pack.ads | 16 ++++++++++++++++ 7 files changed, 67 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/freezing1.adb create mode 100644 gcc/testsuite/gnat.dg/freezing1.ads create mode 100644 gcc/testsuite/gnat.dg/freezing1_pack.adb create mode 100644 gcc/testsuite/gnat.dg/freezing1_pack.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 368e120ce2d..5d58a2cfab0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-07-01 Hristian Kirtchev + + * 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 * doc/gnat_ugn/building_executable_programs_with_gnat.rst: Fix diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 8e55fb8ab36..f7e74afab64 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -7665,9 +7665,8 @@ package body Freeze is or else Ekind (Current_Scope) = E_Void then declare - N : constant Node_Id := Current_Scope; - Freeze_Nodes : List_Id := No_List; - Pos : Int := Scope_Stack.Last; + Freeze_Nodes : List_Id := No_List; + Pos : Int := Scope_Stack.Last; begin if Present (Desig_Typ) then @@ -7700,7 +7699,19 @@ package body Freeze is end if; 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 := Freeze_Nodes; else diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e5206340021..a64cb528b27 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-07-01 Hristian Kirtchev + + * 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 PR lto/91028 diff --git a/gcc/testsuite/gnat.dg/freezing1.adb b/gcc/testsuite/gnat.dg/freezing1.adb new file mode 100644 index 00000000000..87d8246ef84 --- /dev/null +++ b/gcc/testsuite/gnat.dg/freezing1.adb @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Freezing1 is + procedure Foo is null; +end Freezing1; diff --git a/gcc/testsuite/gnat.dg/freezing1.ads b/gcc/testsuite/gnat.dg/freezing1.ads new file mode 100644 index 00000000000..f81bc789868 --- /dev/null +++ b/gcc/testsuite/gnat.dg/freezing1.ads @@ -0,0 +1,10 @@ +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; diff --git a/gcc/testsuite/gnat.dg/freezing1_pack.adb b/gcc/testsuite/gnat.dg/freezing1_pack.adb new file mode 100644 index 00000000000..11172af7fae --- /dev/null +++ b/gcc/testsuite/gnat.dg/freezing1_pack.adb @@ -0,0 +1,8 @@ +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; diff --git a/gcc/testsuite/gnat.dg/freezing1_pack.ads b/gcc/testsuite/gnat.dg/freezing1_pack.ads new file mode 100644 index 00000000000..74d88b8353f --- /dev/null +++ b/gcc/testsuite/gnat.dg/freezing1_pack.ads @@ -0,0 +1,16 @@ +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; -- 2.30.2