The change has uncovered a couple of latent issues: 1) Convert_To_Positional
can duplicate thousands of elements when an "others" choice is present in an
aggregate for a multi-dimensional array and 2) Analyze_Object_Declaration
can leave a dynamic actual subtype on a constant whose value is a static
array aggregate, which makes the code generator choke. This also contains
a couple of other adjustments to the aggregate expansion machinery.
Tested on x86-64/Linux, applied on the mainline.
2026-09-29 Eric Botcazou <[email protected]>
* exp_aggr.adb (Convert_To_Positional.Flatten): Take into account
the elements of a nested array aggregate when deciding to duplicate
the element covered by an "others" choice.
(Convert_To_Positional.Is_Static_Element): Return again false for
a compile-time known aggregate whose expansion has been delayed.
(Compile_Time_Known_Composite_Value): Delete.
(Expand_Record_Aggregate): Call Compile_Time_Known_Value on the
expression whatever its type.
* sem_ch3.adb (Analyze_Object_Declaration): Propagate the subtype
of an expression, which is a static array aggregate whose nominal
component subtype is an unconstrained discriminated record type,
to the actual subtype of the object if it is declared as constant.
--
Eric Botcazoudiff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index da302cb048c..80cd87f5d96 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -4635,6 +4635,7 @@ package body Exp_Aggr is
-- Same data as Vals in list form
Rep_Count : Nat;
+ Rep_Incr : Nat;
-- Used to validate Max_Others_Replicate limit
Elmt : Node_Id;
@@ -4697,10 +4698,38 @@ package body Exp_Aggr is
if Nkind (Choice) = N_Others_Choice then
Rep_Count := 0;
+ -- If the element is an array aggregate, count its own
+ -- elements as replicated. Of course, this takes into
+ -- account only a single nesting level, but arrays with
+ -- more than two dimensions are rare in practice.
+
+ if Nkind (Expr) = N_Aggregate
+ and then Present (Aggregate_Bounds (Expr))
+ and then
+ Compile_Time_Known_Value
+ (High_Bound (Aggregate_Bounds (Expr)))
+ and then
+ Compile_Time_Known_Value
+ (Low_Bound (Aggregate_Bounds (Expr)))
+ then
+ declare
+ Bnds : constant Node_Id := Aggregate_Bounds (Expr);
+ Incr : constant Uint :=
+ UI_Max (Expr_Value (High_Bound (Bnds)) -
+ Expr_Value (Low_Bound (Bnds)) + 1,
+ Uint_1);
+ begin
+ Rep_Incr := UI_To_Int (Incr);
+ end;
+
+ else
+ Rep_Incr := 1;
+ end if;
+
for J in Vals'Range loop
if No (Vals (J)) then
Vals (J) := New_Copy_Tree (Expr);
- Rep_Count := Rep_Count + 1;
+ Rep_Count := Rep_Count + Rep_Incr;
-- Check for maximum others replication. Note that
-- we skip this test if either of the restrictions
@@ -4890,18 +4919,17 @@ package body Exp_Aggr is
begin
-- In most cases the interesting expressions are unambiguously static
- if Compile_Time_Known_Value (Expr) then
+ if Nkind (Expr) = N_Aggregate
+ and then Compile_Time_Known_Aggregate (Expr)
+ then
+ return not Expansion_Delayed (Expr);
+
+ elsif Compile_Time_Known_Value (Expr) then
return True;
elsif Nkind (N) = N_Iterated_Component_Association then
return False;
- elsif Nkind (Expr) = N_Aggregate
- and then Compile_Time_Known_Aggregate (Expr)
- and then not Expansion_Delayed (Expr)
- then
- return True;
-
else
return False;
end if;
@@ -8072,14 +8100,6 @@ package body Exp_Aggr is
procedure Build_Back_End_Aggregate;
-- Build a proper aggregate to be handled by the back-end
- function Compile_Time_Known_Composite_Value (N : Node_Id) return Boolean;
- -- Returns true if N is an expression of composite type which can be
- -- fully evaluated at compile time without raising constraint error.
- -- Such expressions can be passed as is to Gigi without any expansion.
- --
- -- This returns true for N_Aggregate with Compile_Time_Known_Aggregate
- -- set and constants whose expression is such an aggregate, recursively.
-
function Component_OK_For_Backend return Boolean;
-- Check for presence of a component which makes it impossible for the
-- backend to process the aggregate, thus requiring the use of a series
@@ -8443,45 +8463,6 @@ package body Exp_Aggr is
end if;
end Build_Back_End_Aggregate;
- ----------------------------------------
- -- Compile_Time_Known_Composite_Value --
- ----------------------------------------
-
- function Compile_Time_Known_Composite_Value
- (N : Node_Id) return Boolean
- is
- begin
- -- If we have an entity name, then see if it is the name of a
- -- constant and if so, test the corresponding constant value.
-
- if Is_Entity_Name (N) then
- declare
- E : constant Entity_Id := Entity (N);
- V : Node_Id;
- begin
- if Ekind (E) /= E_Constant then
- return False;
- else
- V := Constant_Value (E);
- return Present (V)
- and then Compile_Time_Known_Composite_Value (V);
- end if;
- end;
-
- -- We have a value, see if it is compile time known
-
- else
- if Nkind (N) = N_Aggregate then
- return Compile_Time_Known_Aggregate (N);
- end if;
-
- -- All other types of values are not known at compile time
-
- return False;
- end if;
-
- end Compile_Time_Known_Composite_Value;
-
------------------------------
-- Component_OK_For_Backend --
------------------------------
@@ -8562,14 +8543,8 @@ package body Exp_Aggr is
elsif Possible_Bit_Aligned_Component (Expr_Q) then
Static_Components := False;
return False;
- end if;
-
- if Is_Elementary_Type (Etype (Expr_Q)) then
- if not Compile_Time_Known_Value (Expr_Q) then
- Static_Components := False;
- end if;
- elsif not Compile_Time_Known_Composite_Value (Expr_Q) then
+ elsif not Compile_Time_Known_Value (Expr_Q) then
Static_Components := False;
if Is_Private_Type (Etype (Expr_Q))
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 504d77ce03b..44fa07dfd8a 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5206,17 +5206,28 @@ package body Sem_Ch3 is
Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc));
Freeze_Before (N, Act_T);
- -- If this is a constant declaration of an unconstrained type and
- -- the initialization is an aggregate, we can use the subtype of the
- -- aggregate for the declared entity because it is immutable.
-
- elsif not Is_Constrained (T)
- and then Has_Discriminants (T)
- and then Constant_Present (N)
- and then not Has_Unchecked_Union (T)
- and then Nkind (E) = N_Aggregate
- then
- Act_T := Etype (E);
+ -- If this is the declaration of a constant whose nominal subtype is an
+ -- unconstrained discriminated record type, or a constrained array type
+ -- whose component type is such a type, then we can use the subtype of
+ -- the aggregate for the constant because it is immutable.
+
+ elsif Constant_Present (N) and then Nkind (E) = N_Aggregate then
+ declare
+ function Is_UDR (Typ : Entity_Id) return Boolean is
+ (not Is_Constrained (Typ)
+ and then Has_Discriminants (Typ)
+ and then not Has_Unchecked_Union (Typ));
+ -- Whether Typ is an unconstrained discriminated record type
+
+ begin
+ if Is_UDR (T)
+ or else (Is_Array_Type (T)
+ and then Is_Constrained (T)
+ and then Is_UDR (Component_Type (T)))
+ then
+ Act_T := Etype (E);
+ end if;
+ end;
end if;
-- Check No_Wide_Characters restriction
