[gcc r16-4139] Ada: Fix internal error on ill-formed Reduce attribute in Ada 2022

[Eric Botcazou]

https://gcc.gnu.org/g:3d62068b69f5148450a0881a4ded7d0eae46d3c9

commit r16-4139-g3d62068b69f5148450a0881a4ded7d0eae46d3c9
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Tue Sep 30 11:55:18 2025 +0200

    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:
---
 gcc/ada/sem_attr.adb              | 13 ++++++++++---
 gcc/testsuite/gnat.dg/reduce1.adb | 14 ++++++++++++++
 2 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index bde4d40dcb53..e9e245afb609 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 000000000000..601be4bcbcb0
--- /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;