From 07118f4832ab8a2eaa1cb564cf8d852a3c4b175c Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Mon, 27 Sep 2021 16:15:39 +0200 Subject: [PATCH] [Ada] Fix crash on array component with Default_Value gcc/ada/ * exp_util.adb (Inside_Init_Proc): Simplify. * sem_aggr.adb (Resolve_Record_Aggregate): Fix style. * sem_util.adb (Compile_Time_Constraint_Error): Guard against calling Corresponding_Concurrent_Type with an array type entity. --- gcc/ada/exp_util.adb | 4 +--- gcc/ada/sem_aggr.adb | 4 ++-- gcc/ada/sem_util.adb | 13 +++++++++---- 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index cb180967d67f..11499e155fc0 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7994,10 +7994,8 @@ package body Exp_Util is ---------------------- function Inside_Init_Proc return Boolean is - Proc : constant Entity_Id := Enclosing_Init_Proc; - begin - return Proc /= Empty; + return Present (Enclosing_Init_Proc); end Inside_Init_Proc; ---------------------- diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 9ae5ff616179..b51a3d0c17b5 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -5307,8 +5307,8 @@ package body Sem_Aggr is Add_Association (Component => Component, - Expr => Empty, - Assoc_List => New_Assoc_List, + Expr => Empty, + Assoc_List => New_Assoc_List, Is_Box_Present => True); elsif Present (Parent (Component)) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b5f3d4cce034..20e4395e4f3c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6589,11 +6589,16 @@ package body Sem_Util is if Inside_Init_Proc then declare + Init_Proc_Type : constant Entity_Id := + Entity (Parameter_Type (First + (Parameter_Specifications + (Parent (Current_Scope_No_Loops))))); + Conc_Typ : constant Entity_Id := - Corresponding_Concurrent_Type - (Entity (Parameter_Type (First - (Parameter_Specifications - (Parent (Current_Scope)))))); + (if Present (Init_Proc_Type) + and then Init_Proc_Type in E_Record_Type_Id + then Corresponding_Concurrent_Type (Init_Proc_Type) + else Empty); begin -- Don't complain if the corresponding concurrent type -- 2.47.2