[gcc r16-9585] Ada: Fix missing sliding for assignment of aggregate to unconstrained formal
Eric Botcazou
ebotcazou@gcc.gnu.org
Mon Aug 24 14:57:20 GMT 2026
https://gcc.gnu.org/g:96d5e25082f4178f043e001613b2759e4e3cda9e
commit r16-9585-g96d5e25082f4178f043e001613b2759e4e3cda9e
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon Aug 24 16:38:40 2026 +0200
Ada: Fix missing sliding for assignment of aggregate to unconstrained formal
This is a recent regression present on the mainline, 16 and 15 branches.
The compiler fails to implement the needed sliding when an array aggregate
with specified bounds is assigned to an unconstrained formal parameter,
because the Must_Slide predicate considers only the case of an object
declaration when the object subtype is unconstrained.
gcc/ada/
PR ada/127026
* exp_aggr.adb (Must_Slide): Reorder parameters, rename Obj_Type to
Ob_Typ and add Assign boolean parameter. Return Assign's value in
the case where Obj_Typ is unconstrained.
(Build_Array_Aggr_Code): Adjust call to Must_Slide.
(In_Place_Assign_OK): Likewise.
(Expand_Array_Aggregate): Likewise.
gcc/testsuite/
* gnat.dg/array43.adb: New test.
Diff:
---
gcc/ada/exp_aggr.adb | 48 +++++++++++++++++++++++----------------
gcc/testsuite/gnat.dg/array43.adb | 19 ++++++++++++++++
2 files changed, 47 insertions(+), 20 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 4077a8e17d26..408b21cfa44f 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -138,19 +138,22 @@ package body Exp_Aggr is
-- constants that are done in place.
function Must_Slide
- (Aggr : Node_Id;
- Obj_Type : Entity_Id;
- Typ : Entity_Id) return Boolean;
+ (Aggr : Node_Id;
+ Typ : Entity_Id;
+ Obj_Typ : Entity_Id;
+ Assign : Boolean) return Boolean;
+ -- Return whether an array aggregate Aggr whose subtype is Typ must slide
+ -- when assigned to an object whose (nominal) subtype is Obj_Typ. Assign
+ -- is True when the context is an assignment statement and False when it
+ -- is an object declaration or an allocator.
+
-- A static array aggregate in an object declaration can in most cases be
-- expanded in place. The one exception is when the aggregate is given
-- with component associations that specify different bounds from those of
-- the type definition in the object declaration. In this pathological
-- case the aggregate must slide, and we must introduce an intermediate
- -- temporary to hold it.
- --
- -- The same holds in an assignment to multi-dimensional arrays, when
- -- components may be given with bounds that differ from those of the
- -- component type.
+ -- temporary to hold it. The same holds in an assignment, when components
+ -- may be given with bounds that differ from those of the target.
function Number_Of_Choices (N : Node_Id) return Nat;
-- Returns the number of discrete choices (not including the others choice
@@ -1443,7 +1446,8 @@ package body Exp_Aggr is
if Nkind (Parent (N)) = N_Assignment_Statement
and then Is_Array_Type (Comp_Typ)
and then Present (Component_Associations (Expr_Q))
- and then Must_Slide (N, Comp_Typ, Etype (Expr_Q))
+ and then
+ Must_Slide (N, Etype (Expr_Q), Comp_Typ, Assign => True)
then
Set_Expansion_Delayed (Expr_Q, False);
Set_Analyzed (Expr_Q, False);
@@ -4245,7 +4249,8 @@ package body Exp_Aggr is
-- statically equal to those of the target.
if Is_Array
- and then Must_Slide (N, Etype (Name (Parent_Node)), Etype (N))
+ and then
+ Must_Slide (N, Etype (N), Etype (Name (Parent_Node)), Assign => True)
then
return False;
end if;
@@ -6270,8 +6275,9 @@ package body Exp_Aggr is
or else Needs_Finalization (Typ)
or else not Must_Slide
(N,
+ Typ,
Designated_Type (Etype (Parent_Node)),
- Typ)))
+ Assign => False)))
-- Object declaration (see Convert_Aggr_In_Object_Decl). Sliding
-- cannot be done in place for the time being.
@@ -6285,9 +6291,10 @@ package body Exp_Aggr is
(Defining_Identifier (Parent_Node))
or else not Must_Slide
(N,
+ Typ,
Etype
(Defining_Identifier (Parent_Node)),
- Typ)))
+ Assign => False)))
-- Safe assignment (see Convert_Aggr_In_Assignment). So far only the
-- assignments in init procs are taken into account, as well those
@@ -9604,9 +9611,10 @@ package body Exp_Aggr is
----------------
function Must_Slide
- (Aggr : Node_Id;
- Obj_Type : Entity_Id;
- Typ : Entity_Id) return Boolean
+ (Aggr : Node_Id;
+ Typ : Entity_Id;
+ Obj_Typ : Entity_Id;
+ Assign : Boolean) return Boolean
is
begin
-- No sliding if the type of the object is not established yet, if it is
@@ -9615,13 +9623,13 @@ package body Exp_Aggr is
-- an Others_Clause it gets its type from the context and no sliding
-- is involved either.
- if not Is_Array_Type (Obj_Type) then
+ if not Is_Array_Type (Obj_Typ) then
return False;
- elsif not Is_Constrained (Obj_Type) then
- return False;
+ elsif not Is_Constrained (Obj_Typ) then
+ return Assign;
- elsif Typ = Obj_Type then
+ elsif Typ = Obj_Typ then
return False;
elsif Is_Others_Aggregate (Aggr) then
@@ -9631,7 +9639,7 @@ package body Exp_Aggr is
else
declare
- Obj_Index : Node_Id := First_Index (Obj_Type);
+ Obj_Index : Node_Id := First_Index (Obj_Typ);
Obj_Bounds : Range_Nodes;
Typ_Index : Node_Id := First_Index (Typ);
Typ_Bounds : Range_Nodes;
diff --git a/gcc/testsuite/gnat.dg/array43.adb b/gcc/testsuite/gnat.dg/array43.adb
new file mode 100644
index 000000000000..973c57efe441
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/array43.adb
@@ -0,0 +1,19 @@
+-- { dg-do run }
+
+procedure Array43 is
+
+ type Arr is array (Integer range <>) of Integer;
+
+ procedure Fill (B : out Arr; N : Integer) is
+ begin
+ B := (1 .. N => 7);
+ end Fill;
+
+ V : Arr (5 .. 8) := (others => 0);
+
+begin
+ Fill (V, V'Length);
+ if V /= (V'First .. V'Last => 7) then
+ raise Program_Error;
+ end if;
+end;
More information about the Gcc-cvs
mailing list