From: Eric Botcazou Date: Sun, 7 Dec 2025 22:40:25 +0000 (+0100) Subject: Ada: Fix wrong Accum_Type inferred for a reduction expression X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=09da4112cbb38de230973ea8296816371ecb38b4;p=thirdparty%2Fgcc.git Ada: Fix wrong Accum_Type inferred for a reduction expression This was reported as a regression in GCC 14: the compiler resolves Accum_Type to Positive for a reduction expression whose "expected subtype" is Positive, which means that 0 cannot be used as initial value in the expression: Sum : Positive := V'Reduce ("+", 0); without always raising Constraint_Error as run time. That's not the intent according to T. Taft in https://forum.ada-lang.io/t/regression-in-gnat-14/890 so this changes the resolution to use the base type (Integer) instead. gcc/ada/ PR ada/115349 * sem_attr.adb (Resolve_Attribute) : Use the base type as Accum_Type if the reducer is an operator from Standard and the type is numeric. Use the type of the first operand for other operators. Streamline the error message given for limited types. gcc/testsuite/ * gnat.dg/reduce3.adb: New test. --- diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index ca19cada29e..74e9d6faa28 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -12919,7 +12919,7 @@ package body Sem_Attr is -- Where the context is augmented with the iteration -- variable I of the right type, and Init_Var of type - -- Accum_Subtype. If the Reducer has both procedure and + -- Accum_Typ. If the Reducer has both procedure and -- function interpretations with the proper reducer profile -- an ambiguity error is emitted. Note that, this could be a -- false positive as the two may coexist without ambiguity @@ -13204,7 +13204,7 @@ package body Sem_Attr is return; end if; - -- If no error has been posted and the accumulation type is + -- If no error has been posted and the accumulator type is -- constrained, then the resolution of the reducer can start. if Nkind (Reducer_N) = N_Attribute_Reference then @@ -13252,44 +13252,50 @@ package body Sem_Attr is end if; end if; - -- After resolving the reducer, determine the correct - -- Accum_Subtype: if the reducer is an attribute (Min or Max), - -- then the prefix type is the accumulation type. + -- After resolving the reducer, determine Accum_Typ: if the + -- reducer is an attribute (Min or Max), then its prefix is + -- the accumulator type. if Nkind (Reducer_E) = N_Attribute_Reference then - Accum_Typ := Etype (Prefix (Reducer_E)); + Accum_Typ := Entity (Prefix (Reducer_E)); - -- If an operator from standard, then the type of its first - -- formal woudl be Any_Type, in this case we make sure we don't - -- use an universal type to avoid resolution problems later on. + -- If the reducer is an operator from Standard, then the type + -- of its first operand would be Any_Type. In this case, make + -- sure we do not have an universal type to avoid resolution + -- problems later on, and use the base type of numeric types + -- to avoid spurious subtype mismatches for the initial value. - elsif Ekind (Reducer_E) = E_Operator - or else Scope (Reducer_E) = Standard_Standard - then + elsif Scope (Reducer_E) = Standard_Standard then if Accum_Typ = Universal_Integer then Accum_Typ := Standard_Integer; elsif Accum_Typ = Universal_Real then Accum_Typ := Standard_Float; + elsif Is_Numeric_Type (Accum_Typ) then + Accum_Typ := Base_Type (Accum_Typ); end if; - -- Otherwise, the Accum_Subtype is the subtype of the first - -- formal of the reducer subprogram RM 4.5.10(19/5). + -- Otherwise, Accum_Typ is the subtype of the first formal + -- of the reducer subprogram (RM 4.5.10(19/5)). + + elsif Ekind (Reducer_E) = E_Operator then + Accum_Typ := Etype (Left_Opnd (Reducer_E)); else Accum_Typ := Etype (First_Formal (Reducer_E)); end if; + Set_Etype (N, Accum_Typ); - -- Accumulation type must be nonlimited, RM 4.5.10(8/5) + -- The accumulator type must be nonlimited (RM 4.5.10(8/5)) if Is_Limited_Type (Accum_Typ) then Error_Msg_N - ("accumulated subtype of Reduce must be nonlimited", N); + ("type of reduction expression must be nonlimited", N); - -- If the Accum_Typ is an unconstrained array and the reducer + -- If Accum_Typ is an unconstrained array and the reducer -- subprogram is a function then a Constraint_Error will be - -- raised at runtime as most computations will change its - -- length type during the reduction execution, RM 4.5.10(25/5). + -- raised at run time, as most computations will change its + -- length during the reduction execution (RM 4.5.10(25/5)). -- For instance, this is the case with: -- [...]'Reduce ("&", ...) -- When the expression yields non-empty strings, the reduction @@ -13300,7 +13306,7 @@ package body Sem_Attr is elsif Nkind (Reducer_E) /= N_Attribute_Reference and then Ekind (Reducer_E) = E_Function - and then not Is_Numeric_Type (Base_Type (Accum_Typ)) + and then not Is_Numeric_Type (Accum_Typ) and then not Is_Constrained (Accum_Typ) then declare @@ -13318,6 +13324,7 @@ package body Sem_Attr is -- resolving the initial expression and array aggregate. Resolve (Init_Value_Expr, Accum_Typ); + if Nkind (P) = N_Aggregate then Resolve_Aggregate (P, Make_Array_Type (Index => Standard_Positive, diff --git a/gcc/testsuite/gnat.dg/reduce3.adb b/gcc/testsuite/gnat.dg/reduce3.adb new file mode 100644 index 00000000000..55934d09e97 --- /dev/null +++ b/gcc/testsuite/gnat.dg/reduce3.adb @@ -0,0 +1,17 @@ +-- { dg-do run } +-- { dg-options "-gnat2022" } + +with Ada.Containers.Vectors; + +procedure Reduce3 is + + package Qs is new + Ada.Containers.Vectors (Index_Type => Positive, Element_Type => Positive); + + V : Qs.Vector; + Sum : Positive; + +begin + V.Append (1); + Sum := V'Reduce ("+", 0); +end;