https://gcc.gnu.org/g:e1eca9a8f580943d4d38a311e37eb41b5c997086
commit r16-6147-ge1eca9a8f580943d4d38a311e37eb41b5c997086 Author: Eric Botcazou <[email protected]> Date: Tue Dec 16 00:23:56 2025 +0100 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: --- gcc/ada/sem_attr.adb | 21 +++++++++++++-------- gcc/testsuite/gnat.dg/reduce4.adb | 9 +++++++++ gcc/testsuite/gnat.dg/reduce5.adb | 36 ++++++++++++++++++++++++++++++++++++ 3 files changed, 58 insertions(+), 8 deletions(-) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 74e9d6faa28d..fea61caeb428 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; diff --git a/gcc/testsuite/gnat.dg/reduce4.adb b/gcc/testsuite/gnat.dg/reduce4.adb new file mode 100644 index 000000000000..ac27b7c0cc45 --- /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 index 000000000000..e377f6e25486 --- /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;
