https://gcc.gnu.org/g:f6ecd722f2d8549b7c648cce82c79725900b316d
commit r15-10635-gf6ecd722f2d8549b7c648cce82c79725900b316d Author: Eric Botcazou <[email protected]> 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 0941d1bc1eea..d8d3740f6d85 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -17238,15 +17238,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; @@ -17256,9 +17253,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;
