Ada: Fix assertion failure on problematic container aggregate

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

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

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

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index f4fa1ade85c812988a03ab6aa2bacdd6d3177777..1bcb4b9e823845ec626ae37ae099de4a84f825f3 100644 (file)
--- 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

diff --git a/gcc/testsuite/gnat.dg/specs/aggr8.ads b/gcc/testsuite/gnat.dg/specs/aggr8.ads
new file mode 100644 (file)
index 0000000..3847c4e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/aggr8.ads
@@ -0,0 +1,14 @@
+-- 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;