aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJavier Miranda <miranda@adacore.com>2023-08-15 12:57:10 +0000
committerMarc Poulhiès <poulhies@adacore.com>2023-09-05 13:05:14 +0200
commit67138e097ee2af4633fbf904f4251dda5589fc6f (patch)
treec528bd59dc7802007a7f98f636139e23acfa6ced
parent9fc6f15bfe7ebfeef6ebbea48b2c551f79cd25bd (diff)
downloadgcc-67138e097ee2af4633fbf904f4251dda5589fc6f.zip
gcc-67138e097ee2af4633fbf904f4251dda5589fc6f.tar.gz
gcc-67138e097ee2af4633fbf904f4251dda5589fc6f.tar.bz2
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.
-rw-r--r--gcc/ada/exp_aggr.adb23
-rw-r--r--gcc/ada/sem_aggr.adb14
-rw-r--r--gcc/ada/sem_ch13.adb2
3 files changed, 37 insertions, 2 deletions
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index cd5cc0b..cdca24b 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 364217d..e929fea 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 7cd0800..f891359 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);