From: Arnaud Charlet <charlet@adacore.com>
Date: Tue, 1 Dec 2020 14:44:33 +0000 (-0500)
Subject: [Ada] Crash on if expression inside declare expression
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b7e68e7de0fb6dfc9099a333f800dc904eb3c9e7;p=gcc.git

[Ada] Crash on if expression inside declare expression

gcc/ada/

	* sem_res.adb (Resolve_Declare_Expression): Need to establish a
	transient scope in case Expression (N) requires actions to be
	wrapped.  Code cleanup.
	* exp_ch7.adb, exp_ch11.adb: Code cleanup.
---

diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 3ab2ea25eab..a501bf1aa26 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1864,8 +1864,8 @@ package body Exp_Ch11 is
          then
             return Empty;
 
-            --  Test for handled sequence of statements with at least one
-            --  exception handler which might be the one we are looking for.
+         --  Test for handled sequence of statements with at least one
+         --  exception handler which might be the one we are looking for.
 
          elsif Nkind (P) = N_Handled_Sequence_Of_Statements
            and then Present (Exception_Handlers (P))
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 615cc4137c0..42cfb39bf7a 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -6532,7 +6532,7 @@ package body Exp_Ch7 is
 
    begin
       --  Nothing to do if the scope does not manage the secondary stack or
-      --  does not contain meaninful actions for insertion.
+      --  does not contain meaningful actions for insertion.
 
       if not Manage_SS
         and then No (Act_Before)
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 4077ae1b256..f6e0eab84b7 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2298,11 +2298,8 @@ package body Sem_Res is
       --  Declare_Expression and requires scope management.
 
       if Nkind (N) = N_Expression_With_Actions then
-         if Comes_From_Source (N)
-            and then N = Original_Node (N)
-         then
+         if Comes_From_Source (N) and then N = Original_Node (N) then
             Resolve_Declare_Expression (N, Typ);
-
          else
             Resolve (Expression (N), Typ);
          end if;
@@ -7470,7 +7467,8 @@ package body Sem_Res is
      (N   : Node_Id;
       Typ : Entity_Id)
    is
-      Decl : Node_Id;
+      Decl                 : Node_Id;
+      Need_Transient_Scope : Boolean := False;
    begin
       --  Install the scope created for local declarations, if
       --  any. The syntax allows a Declare_Expression with no
@@ -7479,7 +7477,6 @@ package body Sem_Res is
       --  appears as the scope of all entities declared therein.
 
       Decl := First (Actions (N));
-
       while Present (Decl) loop
          exit when Nkind (Decl)
                      in N_Object_Declaration | N_Object_Renaming_Declaration;
@@ -7487,11 +7484,35 @@ package body Sem_Res is
       end loop;
 
       if Present (Decl) then
-         Push_Scope (Scope (Defining_Identifier (Decl)));
+
+         --  Need to establish a transient scope in case Expression (N)
+         --  requires actions to be wrapped.
 
          declare
-            E : Entity_Id := First_Entity (Current_Scope);
+            Node : Node_Id;
+         begin
+            Node := First (Actions (N));
+            while Present (Node) loop
+               if Nkind (Node) = N_Object_Declaration
+                 and then Requires_Transient_Scope
+                            (Etype (Defining_Identifier (Node)))
+               then
+                  Need_Transient_Scope := True;
+                  exit;
+               end if;
 
+               Next (Node);
+            end loop;
+         end;
+
+         if Need_Transient_Scope then
+            Establish_Transient_Scope (Decl, True);
+         else
+            Push_Scope (Scope (Defining_Identifier (Decl)));
+         end if;
+
+         declare
+            E : Entity_Id := First_Entity (Current_Scope);
          begin
             while Present (E) loop
                Set_Current_Entity (E);