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 bde4d40dcb538754dfdf300722033af704c039aa..e9e245afb6098ee02a566393821267ced19688c2 100644 (file)
--- 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 (file)
index 0000000..601be4b
--- /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;