[gcc r14-3687] ada: Crash on function returning empty Ada 2022 aggregate

[gcc r14-3687] ada: Crash on function returning empty Ada 2022 aggregate

[Marc Poulhi?s]

https://gcc.gnu.org/g:67138e097ee2af4633fbf904f4251dda5589fc6f

commit r14-3687-g67138e097ee2af4633fbf904f4251dda5589fc6f
Author: Javier Miranda <miranda@adacore.com>
Date:   Tue Aug 15 12:57:10 2023 +0000

    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:
---
 gcc/ada/exp_aggr.adb | 23 ++++++++++++++++++++++-
 gcc/ada/sem_aggr.adb | 14 ++++++++++++++
 gcc/ada/sem_ch13.adb |  2 +-
 3 files changed, 37 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index cd5cc0b76698..cdca24b7d5d1 100644
--- 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 364217d03db4..e929fea3bb6d 100644
--- 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 7cd0800a56cc..f89135983cf6 100644
--- 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);