From: Javier Miranda <mira...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 cd5cc0b7669..cdca24b7d5d 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 364217d03db..e929fea3bb6 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 7cd0800a56c..f89135983cf 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);
--
2.40.0
