Ada: Fix ICE when comparing reduction expression with integer constant

This a regression present on the mainline, 15 and 14 branches: the compiler
aborts on the comparison of the result of a reduction expression, whose
prefix is an aggregate, and an integer constant, because of a type mismatch
created by the resolution of the reduction expression, which unduly forces
Integer on the expression.

gcc/ada/
	PR ada/123138
	* sem_attr.adb (Resolve_Attribute) <Attribute_Reduce>: Override a
	universal numeric type only if the prefix is not an aggregate.

gcc/testsuite/
	* gnat.dg/reduce4.adb: New test.
	* gnat.dg/reduce5.adb: Likewise.

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 74e9d6faa28d7b16195be8d4ea00c2289f8e36f6..fea61caeb428dcb5207bd0b9f088a7052d2d9a59 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -13260,16 +13260,21 @@ package body Sem_Attr is
                   Accum_Typ := Entity (Prefix (Reducer_E));
 
                --  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.
+               --  of its first operand would be Any_Type.
 
                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;
+                  --  If Accum_Typ is a universal numeric type and the prefix
+                  --  is not an aggregate, use its component type in order to
+                  --  avoid resolution problems later on.
+
+                  if Is_Universal_Numeric_Type (Accum_Typ) then
+                     if Nkind (P) /= N_Aggregate then
+                        Accum_Typ := Component_Type (Etype (P));
+                     end if;
+
+                  --  If Accum_Typ is a specific numeric type, use its base
+                  --  type to avoid subtype mismatches for the initial value.
+
                   elsif Is_Numeric_Type (Accum_Typ) then
                      Accum_Typ := Base_Type (Accum_Typ);
                   end if;

diff --git a/gcc/testsuite/gnat.dg/reduce4.adb b/gcc/testsuite/gnat.dg/reduce4.adb
new file mode 100644 (file)
index 0000000..ac27b7c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/reduce4.adb
@@ -0,0 +1,9 @@
+-- { dg-do compile }
+-- { dg-options "-gnat2022" }
+
+procedure Reduce4 (S : String) is
+begin
+  if [for E of S => 1]'Reduce ("+", 0) = 3 then
+    null;
+  end if;
+end;

diff --git a/gcc/testsuite/gnat.dg/reduce5.adb b/gcc/testsuite/gnat.dg/reduce5.adb
new file mode 100644 (file)
index 0000000..e377f6e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/reduce5.adb
@@ -0,0 +1,36 @@
+-- { dg-do compile }
+-- { dg-options "-gnat2022" }
+
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Reduce5 is
+   subtype Chunk_Number is Natural range 1 .. 8;
+   Grid  : array (1 .. 80, 1 .. 100) of Boolean := (others => (others => False));
+   Partial_Sum, Partial_Max : array (Chunk_Number) of Natural := (others => 0);
+   Partial_Min              : array (Chunk_Number) of Natural := (others => Natural'Last);
+
+begin
+   for I in Grid'Range (1) loop
+      Grid (I, 1) := (for all J in Grid'Range (2) => Grid (I, J) = True);
+   end loop;
+
+   for I in Grid'Range (1) loop
+      declare
+         True_Count : constant Natural :=
+           [for J in Grid'Range(2) => (if Grid (I, J) then 1 else 0)]'Reduce("+",0);
+      begin
+         Partial_Sum (I) := @ + True_Count;
+         Partial_Min (I) := Natural'Min (@, True_Count);
+         Partial_Max (I) := Natural'Max (@, True_Count);
+      end;
+   end loop;
+
+  Put_Line ("Total=" & Natural'Image (Partial_Sum'Reduce ("+", 0)) &
+            ", Min=" & Natural'Image (Partial_Min'Reduce(Natural'Min, Natural'Last)) &
+            ", Max=" & Natural'Image (Partial_Max'Reduce(Natural'Max, 0)));
+
+  Put_Line ("Total=" & Partial_Sum'Reduce ("+", 0)'Image &
+            ", Min=" & Partial_Min'Reduce(Natural'Min, Natural'Last)'Image &
+            ", Max=" & Partial_Max'Reduce(Natural'Max, 0)'Image);
+
+end;