From: Eric Botcazou <ebotcazou@adacore.com>
Date: Tue, 30 Sep 2025 09:55:18 +0000 (+0200)
Subject: Ada: Fix internal error on ill-formed Reduce attribute in Ada 2022
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=3d62068b69f5148450a0881a4ded7d0eae46d3c9;p=thirdparty%2Fgcc.git

Ada: Fix internal error on ill-formed Reduce attribute in Ada 2022

This is an internal error on the new Reduce attribute of Ada 2022 when the
programmer swaps its arguments(!)  The change makes it so that the compiler
gives an error message instead.

gcc/ada/
	PR ada/117517
	* sem_attr.adb (Resolve_Attribute) <Attribute_Reduce>: Try to
	resolve the reducer first.  Fix casing of error message.

gcc/testsuite/
	* gnat.dg/reduce1.adb: New test.
---

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index bde4d40dcb5..e9e245afb60 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -12851,7 +12851,10 @@ package body Sem_Attr is
                end Proper_Op;
 
             begin
-               Resolve (Init_Value_Exp, Typ);
+               --  First try to resolve the reducer and then, if this succeeds,
+               --  resolve the initial value.  This nicely deals with confused
+               --  programmers who swap the two items.
+
                if Is_Overloaded (Reducer_Subp_Name) then
                   Outer :
                   for Retry in Boolean loop
@@ -12873,14 +12876,18 @@ package body Sem_Attr is
                then
                   Op := Reducer_Subp_Name;
 
-               elsif Proper_Op (Entity (Reducer_Subp_Name)) then
+               elsif Is_Entity_Name (Reducer_Subp_Name)
+                 and then Proper_Op (Entity (Reducer_Subp_Name))
+               then
                   Op := Entity (Reducer_Subp_Name);
                   Set_Etype (N, Typ);
                end if;
 
                if No (Op) then
-                  Error_Msg_N ("No suitable reducer subprogram found",
+                  Error_Msg_N ("no suitable reducer subprogram found",
                     Reducer_Subp_Name);
+               else
+                  Resolve (Init_Value_Exp, Typ);
                end if;
             end;
 
diff --git a/gcc/testsuite/gnat.dg/reduce1.adb b/gcc/testsuite/gnat.dg/reduce1.adb
new file mode 100644
index 00000000000..601be4bcbcb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/reduce1.adb
@@ -0,0 +1,14 @@
+-- { dg-do compile }
+-- { dg-options "-gnat2022" }
+
+procedure Reduce1 is
+
+  type Arr is array (Positive range <>) of Positive;
+
+  A: Arr := (2, 87);
+
+  B: Positive := A'Reduce (1, Positive'Max); -- { dg-error "no suitable" }
+
+begin
+  null;
+end;