ada: Crash on function returning empty Ada 2022 aggregate

The compiler crashes processing a function that returns an empty
aggregate when its returned type is a record type which defined
its container aggregate aspects.

gcc/ada/

	* exp_aggr.adb (Expand_Container_Aggregate): Report warning on
	infinite recursion if an empty container aggregate appears in the
	return statement of its Empty function. Fix typo in comment.
	* sem_aggr.adb (Resolve_Aggregate): Resolve Ada 2022 empty
	aggregate that initializes a record type that has defined its
	container aggregate aspects.
	(Resolve_Iterated_Association): Protect access to attribute Etype.
	* sem_ch13.adb (Resolve_Aspect_Aggregate): Fix typo in comment.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index cd5cc0b76698aeaaa07f82a280a1c992489d2525..cdca24b7d5d1801656ef0f2b4218b469a81c2e00 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6917,6 +6917,10 @@ package body Exp_Aggr is
 
       Siz := Aggregate_Size;
 
+      ---------------------
+      --  Empty function --
+      ---------------------
+
       if Ekind (Entity (Empty_Subp)) = E_Function
         and then Present (First_Formal (Entity (Empty_Subp)))
       then
@@ -6984,7 +6988,7 @@ package body Exp_Aggr is
 
          Append (Init_Stat, Aggr_Code);
 
-         --  Size is dynamic: Create declaration for object, and intitialize
+         --  Size is dynamic: Create declaration for object, and initialize
          --  with a call to the null container, or an assignment to it.
 
       else
@@ -7013,6 +7017,23 @@ package body Exp_Aggr is
          Append (Init_Stat, Aggr_Code);
       end if;
 
+      --  Report warning on infinite recursion if an empty container aggregate
+      --  appears in the return statement of its Empty function.
+
+      if Ekind (Entity (Empty_Subp)) = E_Function
+        and then Nkind (Parent (N)) = N_Simple_Return_Statement
+        and then Is_Empty_List (Expressions (N))
+        and then Is_Empty_List (Component_Associations (N))
+        and then Entity (Empty_Subp) = Current_Scope
+      then
+         Error_Msg_Warn := SPARK_Mode /= On;
+         Error_Msg_N
+           ("!empty aggregate returned by the empty function of a container"
+            & " aggregate<<<", Parent (N));
+         Error_Msg_N
+           ("\this will result in infinite recursion??", Parent (N));
+      end if;
+
       ---------------------------
       --  Positional aggregate --
       ---------------------------

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 364217d03db4e166f7f406dc78a0caac19998019..e929fea3bb6dab3e48acb44594ed5801be25c0c5 100644 (file)
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1065,6 +1065,19 @@ package body Sem_Aggr is
 
          Resolve_Container_Aggregate (N, Typ);
 
+      --  Check Ada 2022 empty aggregate [] initializing a record type that has
+      --  aspect aggregate; the empty aggregate will be expanded into a call to
+      --  the empty function specified in the aspect aggregate.
+
+      elsif Has_Aspect (Typ, Aspect_Aggregate)
+        and then Ekind (Typ) = E_Record_Type
+        and then Is_Homogeneous_Aggregate (N)
+        and then Is_Empty_List (Expressions (N))
+        and then Is_Empty_List (Component_Associations (N))
+        and then Ada_Version >= Ada_2022
+      then
+         Resolve_Container_Aggregate (N, Typ);
+
       elsif Is_Record_Type (Typ) then
          Resolve_Record_Aggregate (N, Typ);
 
@@ -3328,6 +3341,7 @@ 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
       then
          declare

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 7cd0800a56cc359c74bcc06dc20a7afc66507b56..f89135983cf64d9e96212b611b417c871bf586ea 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -16470,7 +16470,7 @@ package body Sem_Ch13 is
          Op_Name := Chars (First (Choices (Assoc)));
 
          --  When verifying the consistency of aspects between the freeze point
-         --  and the end of declarqtions, we use a copy which is not analyzed
+         --  and the end of declarations, we use a copy which is not analyzed
          --  yet, so do it now.
 
          Subp_Id := Expression (Assoc);