[gcc r16-6395] Ada: Fix illegal Aggregate aspect not rejected

[Eric Botcazou]

https://gcc.gnu.org/g:5cdb2a59308c9539b23e945c7f5f48743520e476

commit r16-6395-g5cdb2a59308c9539b23e945c7f5f48743520e476
Author: Eric Botcazou <ebotcazou@gcc.gnu.org>
Date:   Fri Dec 26 10:44:57 2025 +0100

    Ada: Fix illegal Aggregate aspect not rejected
    
    The Ada 2022 RM is adamant that the names specified in the Aggregate aspect
    must denote "exactly one" subprogram, in other words that it is illegal to
    use names that denote more than one subprogram in the Aggregate aspect.
    
    gcc/ada/
            PR ada/123289
            * sem_ch13.adb (Resolve_Aspect_Aggregate.Resolve_Operation): Give
            an error if the operation's name denotes more than one subprogram.
    
    gcc/testsuite/
            * gnat.dg/specs/aggr9.ads: New test.

Diff:
---
 gcc/ada/sem_ch13.adb                  | 19 ++++++++++++++-----
 gcc/testsuite/gnat.dg/specs/aggr9.ads | 26 ++++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index a4c97cd05f01..04f9efc66c55 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -18234,15 +18234,12 @@ package body Sem_Ch13 is
       -----------------------
 
       procedure Resolve_Operation (Subp_Id : Node_Id) is
-         Subp : Entity_Id;
-
          I  : Interp_Index;
          It : Interp;
 
       begin
          if not Is_Overloaded (Subp_Id) then
-            Subp := Entity (Subp_Id);
-            if not Pred (Subp) then
+            if not Pred (Entity (Subp_Id)) then
                Error_Msg_NE
                  ("improper aggregate operation for&", Subp_Id, Typ);
             end if;
@@ -18252,9 +18249,21 @@ package body Sem_Ch13 is
             Get_First_Interp (Subp_Id, I, It);
             while Present (It.Nam) loop
                if Pred (It.Nam) then
+                  if Present (Entity (Subp_Id)) then
+                     --  ??? Cope with the obsolete renaming of Append_Vector
+                     --  in Ada.Containers.Vectors retained for compatibility.
+
+                     if No (Alias (Entity (Subp_Id)))
+                       and then No (Alias (It.Nam))
+                     then
+                        Error_Msg_N
+                          ("& must denote exactly one subprogram", Subp_Id);
+                     end if;
+
+                     exit;
+                  end if;
                   Set_Is_Overloaded (Subp_Id, False);
                   Set_Entity (Subp_Id, It.Nam);
-                  exit;
                end if;
 
                Get_Next_Interp (I, It);
diff --git a/gcc/testsuite/gnat.dg/specs/aggr9.ads b/gcc/testsuite/gnat.dg/specs/aggr9.ads
new file mode 100644
index 000000000000..50677de750b8
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/aggr9.ads
@@ -0,0 +1,26 @@
+-- PR ada/123289
+-- { dg-do compile }
+-- { dg-options "-gnat2022" }
+
+package Aggr9 is
+
+   type JSON_Value is tagged null record;
+   type JSON_Object is new JSON_Value with null record
+     with Aggregate => (Empty => Empty, Add_Named => Insert); -- { dg-error "exactly one" }
+   type JSON_Integer is new JSON_Value with null record
+     with Integer_Literal => From_Universal_Image;
+
+   function Empty return JSON_Object
+   is (null record);
+
+   procedure Insert
+      (O : in out JSON_Object; Key : String; Value : JSON_Integer'Class)
+   is null;
+
+   procedure Insert (O : in out JSON_Object; Key : String; Value : String)
+   is null;
+
+   function From_Universal_Image (Value : String) return JSON_Integer
+   is (null record);
+
+end Aggr9;