From d85badc750ae2eafa81d442e1702dd01cfbc3a82 Mon Sep 17 00:00:00 2001 From: Bob Duff 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 * 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 4455049e43a..5fcfdc47356 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2014-11-20 Bob Duff + + * 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 * debug.adb: Minor comment fix. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index eb5f28f9e65..595c5488b87 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)) -- 2.30.2