https://gcc.gnu.org/g:a0cf00f7e45909a2b9eee2963def21af007f941e
commit r17-4761-ga0cf00f7e45909a2b9eee2963def21af007f941e Author: Eric Botcazou <[email protected]> Date: Tue Sep 29 12:04:02 2026 +0200 Ada: Fix fallout of recent change to handling of static aggregates 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. gcc/ada/ * 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. Diff: --- gcc/ada/exp_aggr.adb | 99 ++++++++++++++++++++-------------------------------- gcc/ada/sem_ch3.adb | 33 ++++++++++++------ 2 files changed, 59 insertions(+), 73 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index da302cb048c1..80cd87f5d96e 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 504d77ce03b3..44fa07dfd8a7 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
