[Ada] Fix PR ada/120665

[Eric Botcazou]

This is an assertion failure on code using a container aggregate in the 
primitives referenced by the Aggregate aspect, which cannot work.

Tested on x86-64/Linux, applied on the mainline.


2025-06-17  Eric Botcazou  <ebotca...@adacore.com>

        PR ada/120665
        * sem_aggr.adb (Resolve_Container_Aggregate): Use robust guards.


2025-06-17  Eric Botcazou  <ebotca...@adacore.com>

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

-- 
Eric Botcazou
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index f4fa1ade85c..1bcb4b9e823 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -4054,8 +4054,8 @@ package body Sem_Aggr is
 
       if Present (Add_Unnamed_Subp)
         and then No (New_Indexed_Subp)
-        and then Present (Etype (Add_Unnamed_Subp))
-        and then Etype (Add_Unnamed_Subp) /= Any_Type
+        and then Present (Entity (Add_Unnamed_Subp))
+        and then Entity (Add_Unnamed_Subp) /= Any_Id
       then
          declare
             Elmt_Type : constant Entity_Id :=
@@ -4101,7 +4101,8 @@ package body Sem_Aggr is
          end;
 
       elsif Present (Add_Named_Subp)
-        and then Etype (Add_Named_Subp) /= Any_Type
+        and then Present (Entity (Add_Named_Subp))
+        and then Entity (Add_Named_Subp) /= Any_Id
       then
          declare
             --  Retrieves types of container, key, and element from the
@@ -4155,7 +4156,8 @@ package body Sem_Aggr is
          end;
 
       elsif Present (Assign_Indexed_Subp)
-        and then Etype (Assign_Indexed_Subp) /= Any_Type
+        and then Present (Entity (Assign_Indexed_Subp))
+        and then Entity (Assign_Indexed_Subp) /= Any_Id
       then
          --  Indexed Aggregate. Positional or indexed component
          --  can be present, but not both. Choices must be static

-- PR ada/120665
-- { dg-do compile }
-- { dg-options "-gnat2022" }

package Aggr8 is

  type T is null record
    with Aggregate => (Empty => Empty, Add_Named => Add_Named);

  function Empty return T is ([]);  -- { dg-warning "empty|infinite" }

  procedure Add_Named (this : in out T; k : Integer; v : Integer) is null;

end Aggr8;