[Ada] Fix too large secondary stack allocation for aggregate return
Checks
Commit Message
This is a regression present on the mainline and 15 branch. The problematic
allocation may occur when the result type of the function is a discriminated
record type with defaulted discriminants. Although it had been present for
a long time when the type is limited, the problem was recently propagated
to nonlimited types because of an optimization.
While the fix is a one-liner, the change also makes it so that SS_Allocate
raises a Storage_Error when the size overflows, like the other allocators.
Tested on x86-64/Linux, applied on the mainline and 15 branch.
2026-04-05 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch6.adb (Expand_Simple_Function_Return): Use a constant return
object when the simple return is rewritten as an extended one.
* libgnat/s-secsta.adb (SS_Allocate): Raise Storage_Error if the
requested size is negative.
* libgnat/s-secsta__cheri.adb (SS_Allocate): Likewise.
2026-04-05 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/aggr35.adb: New test.
* gnat.dg/aggr35_pkg.ads, gnat.dg/aggr35_pkg.adb: New helper.
@@ -7404,7 +7404,7 @@ package body Exp_Ch6 is
--
-- into
--
- -- return _anonymous_ : <return_subtype> := <expression>
+ -- return _anonymous_ : constant <return_subtype> := <expression>
-- The expansion produced by Expand_N_Extended_Return_Statement will
-- contain simple return statements (for example, a block containing
@@ -7436,6 +7436,7 @@ package body Exp_Ch6 is
Obj_Decl : constant Node_Id :=
Make_Object_Declaration (Loc,
Defining_Identifier => Make_Temporary (Loc, 'R'),
+ Constant_Present => True,
Object_Definition => Subtype_Ind,
Expression => Relocate_Node (Exp));
@@ -644,15 +644,17 @@ package body System.Secondary_Stack is
-- calculated conservatively.
end if;
+ -- Raise Storage_Error if the size has overflowed
+
+ if Storage_Size < 0 then
+ raise Storage_Error with "object too large";
+ end if;
+
-- Round the requested size (plus the needed padding in case of
-- over-alignment) up to the nearest multiple of the default
-- alignment to ensure efficient access and that the next available
-- Byte is always aligned on the default alignement value.
- -- It should not be possible to request an allocation of negative
- -- size.
-
- pragma Assert (Storage_Size >= 0);
Mem_Size := Round_Up (Storage_Size + Padding);
if Sec_Stack_Dynamic then
@@ -673,10 +673,11 @@ package body System.Secondary_Stack is
-- calculated conservatively.
end if;
- -- It should not be possible to request an allocation of negative
- -- size.
+ -- Raise Storage_Error if the size has overflowed
- pragma Assert (Storage_Size >= 0);
+ if Storage_Size < 0 then
+ raise Storage_Error with "object too large";
+ end if;
-- Round the requested size (plus the needed padding in case of
-- over-alignment) to ensure that the CHERI bounds length will be