[Ada] Crash on generic instantiation in ignored Ghost context

The following patch corrects the freezing of entities to properly
preserve all freeze nodes in case of recursive freezing when the context
is ignored Ghost, and the construct frozen is non-Ghost.

2018-12-11  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* freeze.adb (Add_To_Result): Move the ignored Ghost-specific
	handling of freeze nodes to...
	(Freeze_Entity): ...here. This ensures that the freeze nodes of
	constructs that have recursive freezing are preserved when the
	context is ignored Ghost, and the top level construct being
	frozen is non-Ghost.

gcc/testsuite/

	* gnat.dg/ghost3.adb, gnat.dg/ghost3.ads: New testcase.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@267001 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c2fef9cbc852d5a7f1257e09f7426e3422e1087a..b10768b354dd39f9bd8295ab6b85a34a4cd2eb05 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2018-12-11  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * freeze.adb (Add_To_Result): Move the ignored Ghost-specific
+       handling of freeze nodes to...
+       (Freeze_Entity): ...here. This ensures that the freeze nodes of
+       constructs that have recursive freezing are preserved when the
+       context is ignored Ghost, and the top level construct being
+       frozen is non-Ghost.
+
 2018-12-11  Ed Schonberg  <schonberg@adacore.com>
 
        * uintp.ads, uintp.adb (UI_From_Integral): New generic function,

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index a446241175a98c176c818a8f5f33ff9f369dac01..dc3e54cca287fc8fd640d5533d64827f1fd65509 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2241,29 +2241,7 @@ package body Freeze is
 
       procedure Add_To_Result (Fnod : Node_Id) is
       begin
-         --  The Ghost mode of the enclosing context is ignored, while the
-         --  entity being frozen is living. Insert the freezing action prior
-         --  to the start of the enclosing ignored Ghost region. As a result
-         --  the freezeing action will be preserved when the ignored Ghost
-         --  context is eliminated. The insertion must take place even when
-         --  the context is a spec expression, otherwise "Handling of Default
-         --  and Per-Object Expressions" will suppress the insertion, and the
-         --  freeze node will be dropped on the floor.
-
-         if Saved_GM = Ignore
-           and then Ghost_Mode /= Ignore
-           and then Present (Ignored_Ghost_Region)
-         then
-            Insert_Action
-              (Assoc_Node   => Ignored_Ghost_Region,
-               Ins_Action   => Fnod,
-               Spec_Expr_OK => True);
-
-         --  Otherwise add the freezing action to the result list
-
-         else
-            Append_New_To (Result, Fnod);
-         end if;
+         Append_New_To (Result, Fnod);
       end Add_To_Result;
 
       ----------------------------
@@ -5301,6 +5279,7 @@ package body Freeze is
 
       if Is_Itype (E) and then Is_Record_Type (Scope (E)) then
          Test_E := Scope (E);
+
       elsif Is_Itype (E) and then Present (Underlying_Type (Scope (E)))
         and then Is_Record_Type (Underlying_Type (Scope (E)))
       then
@@ -5582,8 +5561,8 @@ package body Freeze is
          --  Here for other than a subprogram or type
 
          else
-            --  If entity has a type, and it is not a generic unit, then
-            --  freeze it first (RM 13.14(10)).
+            --  If entity has a type, and it is not a generic unit, then freeze
+            --  it first (RM 13.14(10)).
 
             if Present (Etype (E))
               and then Ekind (E) /= E_Generic_Function
@@ -5603,7 +5582,7 @@ package body Freeze is
                  and then Has_Delayed_Aspects (E)
                then
                   Set_Has_Delayed_Aspects (E, False);
-                  Set_Has_Delayed_Freeze (E, False);
+                  Set_Has_Delayed_Freeze  (E, False);
                   Set_Freeze_Node (E, Empty);
                end if;
             end if;
@@ -6916,18 +6895,35 @@ package body Freeze is
 
       Check_Debug_Info_Needed (E);
 
-      --  Special handling for subprograms
+      --  If subprogram has address clause then reset Is_Public flag, since we
+      --  do not want the backend to generate external references.
 
-      if Is_Subprogram (E) then
+      if Is_Subprogram (E)
+        and then Present (Address_Clause (E))
+        and then not Is_Library_Level_Entity (E)
+      then
+         Set_Is_Public (E, False);
+      end if;
 
-         --  If subprogram has address clause then reset Is_Public flag, since
-         --  we do not want the backend to generate external references.
+      --  The Ghost mode of the enclosing context is ignored, while the
+      --  entity being frozen is living. Insert the freezing action prior
+      --  to the start of the enclosing ignored Ghost region. As a result
+      --  the freezeing action will be preserved when the ignored Ghost
+      --  context is eliminated. The insertion must take place even when
+      --  the context is a spec expression, otherwise "Handling of Default
+      --  and Per-Object Expressions" will suppress the insertion, and the
+      --  freeze node will be dropped on the floor.
+
+      if Saved_GM = Ignore
+        and then Ghost_Mode /= Ignore
+        and then Present (Ignored_Ghost_Region)
+      then
+         Insert_Actions
+           (Assoc_Node   => Ignored_Ghost_Region,
+            Ins_Actions  => Result,
+            Spec_Expr_OK => True);
 
-         if Present (Address_Clause (E))
-           and then not Is_Library_Level_Entity (E)
-         then
-            Set_Is_Public (E, False);
-         end if;
+         Result := No_List;
       end if;
 
    <<Leave>>

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3bc15f08521d5152d4a68dcb181a41d2c5b3ff8b..bdc7eb443608f56805754dffceeba228ce13dcf1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-12-11  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * gnat.dg/ghost3.adb, gnat.dg/ghost3.ads: New testcase.
+
 2018-12-11  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/bip_cu.adb, gnat.dg/bip_cu_constructor.adb,

diff --git a/gcc/testsuite/gnat.dg/ghost3.adb b/gcc/testsuite/gnat.dg/ghost3.adb
new file mode 100644 (file)
index 0000000..f2ef753
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/ghost3.adb
@@ -0,0 +1,5 @@
+--  { dg-do compile }
+
+package body Ghost3 is
+   procedure Dummy is null;
+end Ghost3;

diff --git a/gcc/testsuite/gnat.dg/ghost3.ads b/gcc/testsuite/gnat.dg/ghost3.ads
new file mode 100644 (file)
index 0000000..8d7ec82
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/ghost3.ads
@@ -0,0 +1,20 @@
+package Ghost3 is
+   type Small_Int is new Natural range 0 .. 5;
+   type Large_Int is new Natural range 0 .. 5000;
+
+   type Rec_Typ is record
+      Comp_1 : Small_Int;
+      Comp_2 : Large_Int;
+   end record;
+
+   generic
+      type Any_Typ;
+   package Gen is
+   end Gen;
+
+   package Freezer with Ghost is
+      package Inst is new Gen (Rec_Typ);
+   end Freezer;
+
+   procedure Dummy;
+end Ghost3;