From d85badc750ae2eafa81d442e1702dd01cfbc3a82 Mon Sep 17 00:00:00 2001
From: Bob Duff <duff@adacore.com>
Date: Thu, 20 Nov 2014 14:26:10 +0000
Subject: [PATCH] exp_attr.adb (Attribute_Max_Size_In_Storage_Elements):
Eliminate 'Class references from the tree, because gigi crashes on 'Class.
2014-11-20 Bob Duff <duff@adacore.com>
* exp_attr.adb (Attribute_Max_Size_In_Storage_Elements):
Eliminate 'Class references from the tree, because gigi crashes on
'Class. Also, don't check Nkind (Attr) -- it is known to be
N_Attribute_Reference. Assert that instead.
From-SVN: r217856
---
gcc/ada/ChangeLog | 7 +++++++
gcc/ada/exp_attr.adb | 19 +++++++++++++++----
2 files changed, 22 insertions(+), 4 deletions(-)
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4455049e43a6..5fcfdc473565 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2014-11-20 Bob Duff <duff@adacore.com>
+
+ * exp_attr.adb (Attribute_Max_Size_In_Storage_Elements):
+ Eliminate 'Class references from the tree, because gigi crashes on
+ 'Class. Also, don't check Nkind (Attr) -- it is known to be
+ N_Attribute_Reference. Assert that instead.
+
2014-11-20 Bob Duff <duff@adacore.com>
* debug.adb: Minor comment fix.
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index eb5f28f9e650..595c5488b87a 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -4215,6 +4215,17 @@ package body Exp_Attr is
-- wrapped inside a type conversion.
begin
+ -- If the prefix is X'Class, we transform it into a direct reference
+ -- to the class-wide type, because the back end must not see a 'Class
+ -- reference. See also 'Size.
+
+ if Is_Entity_Name (Pref)
+ and then Is_Class_Wide_Type (Entity (Pref))
+ then
+ Rewrite (Prefix (N), New_Occurrence_Of (Entity (Pref), Loc));
+ return;
+ end if;
+
Apply_Universal_Integer_Attribute_Checks (N);
-- The universal integer check may sometimes add a type conversion,
@@ -4225,6 +4236,7 @@ package body Exp_Attr is
Attr := Expression (Attr);
Conversion_Added := True;
end if;
+ pragma Assert (Nkind (Attr) = N_Attribute_Reference);
-- Heap-allocated controlled objects contain two extra pointers which
-- are not part of the actual type. Transform the attribute reference
@@ -4234,7 +4246,6 @@ package body Exp_Attr is
-- two pointers are already present in the type.
if VM_Target = No_VM
- and then Nkind (Attr) = N_Attribute_Reference
and then Needs_Finalization (Ptyp)
and then not Header_Size_Added (Attr)
then
@@ -5567,9 +5578,9 @@ package body Exp_Attr is
end if;
end if;
- -- For class-wide types, X'Class'Size is transformed into a direct
- -- reference to the Size of the class type, so that the back end does
- -- not have to deal with the X'Class'Size reference.
+ -- If the prefix is X'Class, we transform it into a direct reference
+ -- to the class-wide type, because the back end must not see a 'Class
+ -- reference.
if Is_Entity_Name (Pref)
and then Is_Class_Wide_Type (Entity (Pref))
--
GitLab