[Ada] Crash on function in Ghost subunit

This patch modifies the creation of class-wide subtypes to preserve vital
attributes related to Ghost code. The subtype is created by copying the
contents of a class-wide type into a newly created itype. When the itype
is created within a Ghost region, the act of copying destroys Ghost code
related attributes. As a result, if the now living class-wide subtype is
frozen within an ignored Ghost region, its freeze node is hoisted prior
to the start of the region, howeve the subtype is still eliminated from
the tree.

------------
-- Source --
------------

--  pack.ads

with Ada.Finalization; use Ada.Finalization;

package Pack is
   type Ctrl is new Controlled with null record;
   function Make_Ctrl return Ctrl;

   package Nested with Ghost is
      procedure Proc;
   end Nested;
end Pack;

--  pack.adb

package body Pack is
   function Make_Ctrl return Ctrl is
   begin
      return Result : Ctrl;
   end Make_Ctrl;

   package body Nested is separate;
end Pack;

--  pack-nested.adb

separate (Pack)

package body Nested is
   procedure Proc is
      Res : constant Ctrl'Class := Make_Ctrl;
   begin null; end Proc;
end Nested;

-----------------
-- Compilation --
-----------------

$ gcc -c pack.adb

2018-05-24  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_util.adb (New_Class_Wide_Subtype): Capture and restore relevant
	Ghost-related attributes of the class-wide subtype because the copy
	clobbers them.

From-SVN: r260653

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6707a1aef0431514422ea3f8b3d7e63b50f61ba9..bf69dbf2d790297ca652536084341bcaa5443831 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2018-05-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_util.adb (New_Class_Wide_Subtype): Capture and restore relevant
+       Ghost-related attributes of the class-wide subtype because the copy
+       clobbers them.
+
 2018-05-24  Justin Squirek  <squirek@adacore.com>
 
        * sem_res.adb (Resolve_Entity_Name): Add guard to protect against

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 5ede9a68958ad87b2688d0eb4f57d7355abd4ebf..8ae2d2ba7dac26f19ecdece2cd7409b6aa54b0c5 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -10580,26 +10580,44 @@ package body Exp_Util is
      (CW_Typ : Entity_Id;
       N      : Node_Id) return Entity_Id
    is
-      Res       : constant Entity_Id := Create_Itype (E_Void, N);
-      Res_Name  : constant Name_Id   := Chars (Res);
-      Res_Scope : constant Entity_Id := Scope (Res);
+      Res : constant Entity_Id := Create_Itype (E_Void, N);
+
+      --  Capture relevant attributes of the class-wide subtype which must be
+      --  restored after the copy.
+
+      Res_Chars  : constant Name_Id   := Chars (Res);
+      Res_Is_CGE : constant Boolean   := Is_Checked_Ghost_Entity (Res);
+      Res_Is_IGE : constant Boolean   := Is_Ignored_Ghost_Entity (Res);
+      Res_Is_IGN : constant Boolean   := Is_Ignored_Ghost_Node   (Res);
+      Res_Scope  : constant Entity_Id := Scope (Res);
 
    begin
       Copy_Node (CW_Typ, Res);
-      Set_Comes_From_Source (Res, False);
-      Set_Sloc (Res, Sloc (N));
-      Set_Is_Itype (Res);
+
+      --  Restore the relevant attributes of the class-wide subtype
+
+      Set_Chars                   (Res, Res_Chars);
+      Set_Is_Checked_Ghost_Entity (Res, Res_Is_CGE);
+      Set_Is_Ignored_Ghost_Entity (Res, Res_Is_IGE);
+      Set_Is_Ignored_Ghost_Node   (Res, Res_Is_IGN);
+      Set_Scope                   (Res, Res_Scope);
+
+      --  Decorate the class-wide subtype
+
       Set_Associated_Node_For_Itype (Res, N);
-      Set_Is_Public (Res, False);   --  By default, may be changed below.
+      Set_Comes_From_Source         (Res, False);
+      Set_Ekind                     (Res, E_Class_Wide_Subtype);
+      Set_Etype                     (Res, Base_Type (CW_Typ));
+      Set_Freeze_Node               (Res, Empty);
+      Set_Is_Frozen                 (Res, False);
+      Set_Is_Itype                  (Res);
+      Set_Is_Public                 (Res, False);
+      Set_Next_Entity               (Res, Empty);
+      Set_Sloc                      (Res, Sloc (N));
+
       Set_Public_Status (Res);
-      Set_Chars (Res, Res_Name);
-      Set_Scope (Res, Res_Scope);
-      Set_Ekind (Res, E_Class_Wide_Subtype);
-      Set_Next_Entity (Res, Empty);
-      Set_Etype (Res, Base_Type (CW_Typ));
-      Set_Is_Frozen (Res, False);
-      Set_Freeze_Node (Res, Empty);
-      return (Res);
+
+      return Res;
    end New_Class_Wide_Subtype;
 
    --------------------------------