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) <Attribute_Reduce>: 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 ca19cada29ec3ae630a97f9f9af643a7454138b7..74e9d6faa28d7b16195be8d4ea00c2289f8e36f6 100644 (file)
--- 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 (file)
index 0000000..55934d0
--- /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;