https://gcc.gnu.org/g:9b7f1ec322bc4e2cbb0687d1f63e4a58aec23dfb
commit r15-9882-g9b7f1ec322bc4e2cbb0687d1f63e4a58aec23dfb
Author: Bob Duff <d...@adacore.com>
Date: Tue Apr 29 13:12:44 2025 -0400
ada: Make class-wide Max_Size_In_Storage_Elements return a large value
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.
Diff:
---
gcc/ada/exp_attr.adb | 34 +++++++++++++++++++++++++++-------
1 file changed, 27 insertions(+), 7 deletions(-)
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 18179d3a4e97..1eff20d14aca 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -5042,22 +5042,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:
