From: Piotr Trojanek <trojanek@adacore.com>
Date: Mon, 27 Sep 2021 14:15:39 +0000 (+0200)
Subject: [Ada] Fix crash on array component with Default_Value
X-Git-Tag: basepoints/gcc-13~4023
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=07118f4832ab8a2eaa1cb564cf8d852a3c4b175c;p=thirdparty%2Fgcc.git

[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.
---

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