Typ : constant Entity_Id := Etype (N);
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.
+ -- Tranform T'Class'Max_Size_In_Storage_Elements (for any T) into
+ -- Storage_Count'Pos (Storage_Count'Last), because it must include
+ -- all descendants, which can be arbitrarily large. Note that the
+ -- back end must not see any 'Class attribute references.
+ -- The 'Pos is to make it be of type universal_integer.
+ --
+ -- ???If T'Class'Size is specified, it should probably affect
+ -- T'Class'Max_Size_In_Storage_Elements accordingly.
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;
+ declare
+ Storage_Count_Type : constant Entity_Id :=
+ RTE (RE_Storage_Count);
+ Attr : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Storage_Count_Type, Loc),
+ Attribute_Name => Name_Pos,
+ Expressions => New_List (
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Storage_Count_Type, Loc),
+ Attribute_Name => Name_Last)));
+ begin
+ Rewrite (N, Attr);
+ Analyze_And_Resolve (N, Typ);
+ return;
+ end;
-- Heap-allocated controlled objects contain two extra pointers which
-- are not part of the actual type. Transform the attribute reference
-- into a runtime expression to add the size of the hidden header.
- if Needs_Finalization (Ptyp) and then not Header_Size_Added (N) then
+ elsif Needs_Finalization (Ptyp)
+ and then not Header_Size_Added (N)
+ then
Set_Header_Size_Added (N);
-- Generate: