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.
Tested on x86-64/Linux, applied on the mainline, 15 and 14 branches.
2025-12-15 Eric Botcazou <[email protected]>
PR ada/123138
* sem_attr.adb (Resolve_Attribute) <Attribute_Reduce>: Override a
universal numeric type only if the prefix is not an aggregate.
2025-12-15 Eric Botcazou <[email protected]>
* gnat.dg/reduce4.adb: New test.
* gnat.dg/reduce5.adb: Likewise.
--
Eric Botcazoudiff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 74e9d6faa28..fea61caeb42 100644
--- 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;
-- { 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;
-- { 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;
