aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHristian Kirtchev <kirtchev@adacore.com>2018-05-24 13:05:26 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2018-05-24 13:05:26 +0000
commitfa3717c173192eb04440734a3ee110982f31e592 (patch)
treecc31ee41442c6c152781125628426dd0b51a799e
parent36e7d49f8afc9bde0ef5691fc5a3ce4330fd3063 (diff)
downloadgcc-fa3717c173192eb04440734a3ee110982f31e592.zip
gcc-fa3717c173192eb04440734a3ee110982f31e592.tar.gz
gcc-fa3717c173192eb04440734a3ee110982f31e592.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog6
-rw-r--r--gcc/ada/exp_util.adb48
2 files changed, 39 insertions, 15 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6707a1a..bf69dbf 100644
--- 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 5ede9a6..8ae2d2b 100644
--- 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;
--------------------------------