]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Make class-wide Max_Size_In_Storage_Elements return a large value
authorBob Duff <duff@adacore.com>
Tue, 29 Apr 2025 17:12:44 +0000 (13:12 -0400)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Mon, 30 Jun 2025 13:47:24 +0000 (15:47 +0200)
Max_Size_In_Storage_Elements is supposed to return a value greater or
equal to what is passed for any heap allocation for an object of the
type. For a tagged type T, we don't know the allocation size for
descendants; therefore T'Class'Max_Size_In_Storage_Elements should
return a huge number. In particular, it now returns Storage_Count'Last,
which is greater than any possible heap allocation.

Previously, T'Class'Max_Size_In_Storage_Elements was returning
the same value as T'Max_Size_In_Storage_Elements, which was
wrong.

gcc/ada/ChangeLog:

* exp_attr.adb (Attribute_Max_Size_In_Storage_Elements):
Return Storage_Count'Last converted to universal_integer.

gcc/ada/exp_attr.adb

index 3d1bff93b408eca2f8ecb868e9c653dc73268778..0f09ba587accd8448a915adf18a98af83e701f9e 100644 (file)
@@ -5353,22 +5353,42 @@ package body Exp_Attr is
          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: