[Ada] Unnesting: find local subps in nested stmt sequences

2018-07-31  Ed Schonberg  <schonberg@adacore.com>

gcc/ada

	* exp_ch7.adb (Check_Unnesting_Elaboration_Code): To find local
	subprograms in the elaboration code for a package body, recurse
	through nested statement sequences because a compiler-generated
	procedure may appear within a condition statement.

From-SVN: r263102

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e54c9e0bb7a859af602148162a9064b065c8efe3..8207826eabee9b4823989fd66aeae4daccce81b7 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-07-31  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch7.adb (Check_Unnesting_Elaboration_Code): To find local
+       subprograms in the elaboration code for a package body, recurse
+       through nested statement sequences because a compiler-generated
+       procedure may appear within a condition statement.
+
 2018-07-31  Ed Schonberg  <schonberg@adacore.com>
 
        * exp_ch6.adb (Expand_Protected_Subprogram_Call): Handle

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index eb352c33bfba9d8a9a02be8d82a69e6d08a12def..1b8b8f254f17f13b6a20a782d70b60d71bb4d099 100644 (file)
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -3995,6 +3995,10 @@ package body Exp_Ch7 is
       --  Check recursively whether a loop or block contains a subprogram that
       --  may need an activation record.
 
+      function First_Local_Scope (L : List_Id) return Entity_Id;
+      --  Find first block or loop that contains a subprogram and is not itself
+      --  nested within another local scope.
+
       --------------------------
       --  Contains_Subprogram --
       --------------------------
@@ -4021,12 +4025,92 @@ package body Exp_Ch7 is
          return False;
       end Contains_Subprogram;
 
+      -----------------------
+      --  Find_Local_Scope --
+      -----------------------
+
+      function First_Local_Scope (L : List_Id) return Entity_Id is
+         Stat : Node_Id;
+         Scop : Entity_Id;
+
+      begin
+         Stat := First (L);
+         while Present (Stat) loop
+            case Nkind (Stat) is
+               when N_Block_Statement =>
+                  if Present (Identifier (Stat)) then
+                     return Entity (Identifier (Stat));
+                  end if;
+
+               when N_Loop_Statement =>
+                  if Contains_Subprogram (Entity (Identifier (Stat))) then
+                     return Entity (Identifier (Stat));
+                  end if;
+
+               when N_If_Statement =>
+                  Scop := First_Local_Scope (Then_Statements (Stat));
+
+                  if Present (Scop) then
+                     return Scop;
+                  end if;
+
+                  Scop := First_Local_Scope (Else_Statements (Stat));
+
+                  if Present (Scop) then
+                     return Scop;
+                  end if;
+
+                  declare
+                     Elif : Node_Id;
+                  begin
+                     Elif := First (Elsif_Parts (Stat));
+
+                     while Present (Elif) loop
+                        Scop := First_Local_Scope (Statements (Elif));
+
+                        if Present (Scop) then
+                           return Scop;
+                        end if;
+
+                        Next (Elif);
+                     end loop;
+                  end;
+
+               when N_Case_Statement =>
+                  declare
+                     Alt : Node_Id;
+                  begin
+                     Alt := First (Alternatives (Stat));
+
+                     while Present (Alt) loop
+                        Scop := First_Local_Scope (Statements (Alt));
+
+                        if Present (Scop) then
+                           return Scop;
+                        end if;
+
+                        Next (Alt);
+                     end loop;
+                  end;
+
+               when N_Subprogram_Body =>
+                  return Defining_Entity (Stat);
+
+               when others =>
+                  null;
+            end case;
+            Next (Stat);
+         end loop;
+
+         return Empty;
+      end First_Local_Scope;
+
       --  Local variables
 
       Elab_Body : Node_Id;
       Elab_Call : Node_Id;
       Elab_Proc : Entity_Id;
-      Stat      : Node_Id;
+      Ent       : Entity_Id;
 
    --  Start of processing for Check_Unnesting_Elaboration_Code
 
@@ -4035,16 +4119,10 @@ package body Exp_Ch7 is
         and then Present (Handled_Statement_Sequence (N))
         and then Is_Compilation_Unit (Current_Scope)
       then
-         Stat := First (Statements (Handled_Statement_Sequence (N)));
-         while Present (Stat) loop
-            exit when ((Nkind (Stat) = N_Block_Statement
-                         and then Present (Identifier (Stat)))
-                or else Nkind (Stat) = N_Loop_Statement)
-              and then Contains_Subprogram (Entity (Identifier (Stat)));
-            Next (Stat);
-         end loop;
+         Ent := First_Local_Scope
+                  (Statements (Handled_Statement_Sequence (N)));
 
-         if Present (Stat) then
+         if Present (Ent) then
             Elab_Proc :=
               Make_Defining_Identifier (Loc,
                 Chars => New_Internal_Name ('I'));
@@ -4077,21 +4155,9 @@ package body Exp_Ch7 is
             --  within those blocks will have activation records if they
             --  contain references to entities in the enclosing block.
 
-            Stat :=
-              First (Statements (Handled_Statement_Sequence (Elab_Body)));
-
-            while Present (Stat) loop
-               if (Nkind (Stat) = N_Block_Statement
-                    and then Present (Identifier (Stat)))
-                 or else Nkind (Stat) = N_Loop_Statement
-               then
-                  Set_Scope (Entity (Identifier (Stat)), Elab_Proc);
-
-               elsif Nkind (Stat) = N_Subprogram_Body then
-                  Set_Scope (Defining_Entity (Stat), Elab_Proc);
-               end if;
-
-               Next (Stat);
+            while Present (Ent) loop
+               Set_Scope (Ent, Elab_Proc);
+               Next_Entity (Ent);
             end loop;
          end if;
       end if;