[Ada] Fix illegal Aggregate aspect not rejected

[Eric Botcazou]

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.

Tested on x86-64/Linux, applied on the mainline, 15 and 14 branches.


2025-12-26  Eric Botcazou  <ebotca...@adacore.com>

        PR ada/123289
        * sem_ch13.adb (Resolve_Aspect_Aggregate.Resolve_Operation): Give
        an error if the operation's name denotes more than one subprogram.


2025-12-26  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/specs/aggr9.ads: New test.

-- 
Eric Botcazou
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index a4c97cd05f0..04f9efc66c5 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);

-- 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;