[Ada] Secondary stack leaks during object initialization

This patch modifies the transient scope mechanism to prevent secondary stack
leaks during object initialization. The modifications are as follows:

1) Prior to this change, the secondary stack was never managed within type
initialization procedures, for reasons unknown. It is speculated that the
controlled type model used at that time may have influenced this decision.
The secondary stack is now managed within type initialization procedures
in order to recover the memory once individual components or whole objects
are initialized.

2) A transient scope now delegates the secondary stack management to an
enclosing scope if there is no suitable context to wrap. This ensures that
the requirement to manage the secondary stack is not lost when the scope was
established for that purpose in mind.

3) A previous mechanism which examined the definition of a type (recursively)
to determine whether the type will involve the secondary stack was removed
because a) the mechanism could not detect this need with certainty, and b) the
trigger for secondary stack usage is now moved to the resolution of function
calls, which is always accurate.

------------
-- Source --
------------

--  types.ads

with Ada.Finalization; use Ada.Finalization;

package Types is
   type Ctrl is new Controlled with record
      Id : Integer;
   end record;

   procedure Initialize (Obj : in out Ctrl);

   function Make_Ctrl return Ctrl;
   function Make_Ctrl_From (Obj : Ctrl) return Ctrl;

   type Constr is array (1 .. 3) of Ctrl;
   type Unconstr is array (Integer range <>) of Ctrl;

   function Make_Constr return Constr;
   function Make_Unconstr (Low : Integer; High : Integer) return Unconstr;

   type Rec_1 is new Controlled with record
      Comp : Ctrl := Make_Ctrl;
   end record;

   type Rec_2 is new Controlled with record
      Comp : Ctrl := Make_Ctrl_From (Make_Ctrl);
   end record;

   type Rec_3 is new Controlled with record
      Comp : Constr := Make_Constr;
   end record;

   type Rec_4 is new Controlled with record
      Comp : Unconstr (1 .. 3) := Make_Unconstr (1, 3);
   end record;

   type Rec_5 is record
      Comp : Integer := 1 + Make_Ctrl.Id;
   end record;

   type Rec_6 is record
      Comp : Boolean := (for all X in 1 .. Make_Ctrl.Id =>
                           X = Make_Ctrl.Id);
   end record;
end Types;

--  types.adb

package body Types is
   Id_Gen : Integer := 0;

   procedure Initialize (Obj : in out Ctrl) is
   begin
      Id_Gen := Id_Gen + 1;
      Obj.Id := Id_Gen;
   end Initialize;

   function Make_Constr return Constr is
      Result : constant Constr := (others => Make_Ctrl);
   begin
      return Result;
   end Make_Constr;

   function Make_Ctrl return Ctrl is
      Result : Ctrl;
   begin
      return Result;
   end Make_Ctrl;

   function Make_Ctrl_From (Obj : Ctrl) return Ctrl is
      Result : Ctrl;
   begin
      Result.Id := Obj.Id;
      return Result;
   end Make_Ctrl_From;

   function Make_Unconstr (Low : Integer; High : Integer) return Unconstr is
      Result : constant Unconstr (Low .. High) := (others => Make_Ctrl);
   begin
      return Result;
   end Make_Unconstr;
end Types;

--  maker.ads

generic
   type Obj_Typ is private;
procedure Maker (Count : Positive);

--  maker.adb

procedure Maker (Count : Positive) is
   procedure Create is
      Obj : Obj_Typ;
      pragma Warnings (Off, Obj);
   begin null; end Create;

begin
   for Iter in 1 .. Count loop
      Create;
   end loop;
end Maker;

--  leaks.adb

with Maker;
with Types; use Types;

with Maker;
with Types; use Types;

procedure Leaks is
   procedure Make_1 is new Maker (Rec_1);
   procedure Make_2 is new Maker (Rec_2);
   procedure Make_3 is new Maker (Rec_3);
   procedure Make_4 is new Maker (Rec_4);
   procedure Make_5 is new Maker (Rec_5);
   procedure Make_6 is new Maker (Rec_6);

begin
   Make_1 (5_000);
   Make_2 (5_000);
   Make_3 (5_000);
   Make_4 (5_000);
   Make_5 (5_000);
   Make_6 (5_000);
end Leaks;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q leaks.adb
$ valgrind ./leaks > leaks.txt 2>&1
$ grep -c "still reachable" leaks.txt
0

2018-01-11  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_aggr.adb (Convert_Aggr_In_Object_Decl): Update the call to
	Establish_Transient_Scope.
	(Convert_To_Assignments): Update the call to Establish_Transient_Scope.
	(Expand_Array_Aggregate): Update the call to Establish_Transient_Scope.
	* exp_ch6.adb (Expand_Call_Helper): Update the call to
	Establish_Transient_Scope.
	(Make_Build_In_Place_Call_In_Object_Declaration): Update the call to
	Establish_Transient_Scope.
	* exp_ch7.adb (Establish_Transient_Scope): Restructured. Delegate the
	management of the secondary stack to an enclosing scope if there is no
	suitable construct to wrap, and the transient scope was intended to
	manage the secondary stack.
	(Find_Node_To_Be_Wrapped): Restructured. A case_statement_alternative
	is a valid boundary for a transient expression which comes from the
	statements of the alternative, otherwise alternatives cannot be
	wrapped. Assignments of controlled objects which have controlled
	actions suppressed now stop the traversal as there is no point in
	looking for an enclosing construct. Add several N_xxx_Body choices to
	the termination conditions for completeness.
	* exp_ch7.ads (Establish_Transient_Scope): Update the parameter profile
	and the associated comment on usage.
	* exp_smem.adb (Add_Shared_Var_Lock_Procs): Update the call to
	Establish_Transient_Scope.
	(Add_Write_After): Update the call to Establish_Transient_Scope.
	* sem_res.adb (Check_Initialization_Call): Removed.
	(Resolve_Actuals): Account for additional cases where finalization
	actions are required by utilizing predicate Needs_Finalization rather
	than Is_Controlled.
	(Resolve_Call): Type initialization procedures can now utilize
	transient scopes to manage the secondary stack, thus preventing leaks
	during initialization.  Remove the previous kludgy algorithm which
	attempts to manage the secondary stack at the object creation site.

From-SVN: r256513

1 files changed, 284 insertions, 169 deletions

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 4dcb38d..e669454 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2018, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -4066,92 +4066,51 @@ package body Exp_Ch7 is
    --  result. It creates a new scope on the scope stack in order to enclose
    --  all transient variables generated.
 
-   procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean) is
-      Loc       : constant Source_Ptr := Sloc (N);
-      Iter_Loop : Entity_Id;
-      Scop_Id   : Entity_Id;
-      Scop_Rec  : Scope_Stack_Entry;
-      Wrap_Node : Node_Id;
-
-   begin
-      --  Do not create a new transient scope if there is an existing transient
-      --  scope on the stack.
-
-      for Index in reverse Scope_Stack.First .. Scope_Stack.Last loop
-         Scop_Rec := Scope_Stack.Table (Index);
-         Scop_Id  := Scop_Rec.Entity;
-
-         --  The current scope is transient. If the scope being established
-         --  needs to manage the secondary stack, then the existing scope
-         --  overtakes that function.
-
-         if Scop_Rec.Is_Transient then
-            if Sec_Stack then
-               Set_Uses_Sec_Stack (Scop_Id);
-            end if;
-
-            return;
-
-         --  Prevent the search from going too far because transient blocks
-         --  are bounded by packages and subprogram scopes. Reaching Standard
-         --  should be impossible without hitting one of the other cases first
-         --  unless Standard was manually pushed.
-
-         elsif Scop_Id = Standard_Standard
-           or else Ekind_In (Scop_Id, E_Entry,
-                                      E_Entry_Family,
-                                      E_Function,
-                                      E_Package,
-                                      E_Procedure,
-                                      E_Subprogram_Body)
-         then
-            exit;
-         end if;
-      end loop;
+   procedure Establish_Transient_Scope
+     (N                : Node_Id;
+      Manage_Sec_Stack : Boolean)
+   is
+      procedure Create_Transient_Scope (Constr : Node_Id);
+      --  Place a new scope on the scope stack in order to service construct
+      --  Constr. The new scope may also manage the secondary stack.
 
-      Wrap_Node := Find_Node_To_Be_Wrapped (N);
+      procedure Delegate_Sec_Stack_Management;
+      --  Move the management of the secondary stack to the nearest enclosing
+      --  suitable scope.
 
-      --  The context does not contain a node that requires a transient scope,
-      --  nothing to do.
+      function Find_Enclosing_Transient_Scope return Entity_Id;
+      --  Examine the scope stack looking for the nearest enclosing transient
+      --  scope. Return Empty if no such scope exists.
 
-      if No (Wrap_Node) then
-         null;
+      function Is_OK_Construct (Constr : Node_Id) return Boolean;
+      --  Determine whether arbitrary node Constr is a suitable construct which
+      --  requires handling by a transient scope.
 
-      --  If the node to wrap is an iteration_scheme, the expression is one of
-      --  the bounds, and the expansion will make an explicit declaration for
-      --  it (see Analyze_Iteration_Scheme, sem_ch5.adb), so do not apply any
-      --  transformations here. Same for an Ada 2012 iterator specification,
-      --  where a block is created for the expression that build the container.
+      function Is_Package_Or_Subprogram (Id : Entity_Id) return Boolean;
+      --  Determine whether arbitrary Id denotes a package or subprogram [body]
 
-      elsif Nkind_In (Wrap_Node, N_Iteration_Scheme,
-                                 N_Iterator_Specification)
-      then
-         null;
+      ----------------------------
+      -- Create_Transient_Scope --
+      ----------------------------
 
-      --  In formal verification mode, if the node to wrap is a pragma check,
-      --  this node and enclosed expression are not expanded, so do not apply
-      --  any transformations here.
+      procedure Create_Transient_Scope (Constr : Node_Id) is
+         Loc : constant Source_Ptr := Sloc (N);
 
-      elsif GNATprove_Mode
-        and then Nkind (Wrap_Node) = N_Pragma
-        and then Get_Pragma_Id (Wrap_Node) = Pragma_Check
-      then
-         null;
+         Iter_Loop  : Entity_Id;
+         Trans_Scop : Entity_Id;
 
-      --  Create a block entity to act as a transient scope. Note that when the
-      --  node to be wrapped is an expression or a statement, a real physical
-      --  block is constructed (see routines Wrap_Transient_Expression and
-      --  Wrap_Transient_Statement) and inserted into the tree.
+      begin
+         Trans_Scop := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B');
+         Set_Etype (Trans_Scop, Standard_Void_Type);
 
-      else
-         Push_Scope (New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'));
+         Push_Scope (Trans_Scop);
+         Set_Node_To_Be_Wrapped (Constr);
          Set_Scope_Is_Transient;
 
-         --  The transient scope must also take care of the secondary stack
-         --  management.
+         --  The transient scope must also manage the secondary stack
 
-         if Sec_Stack then
-            Set_Uses_Sec_Stack (Current_Scope);
+         if Manage_Sec_Stack then
+            Set_Uses_Sec_Stack (Trans_Scop);
             Check_Restriction (No_Secondary_Stack, N);
 
             --  The expansion of iterator loops generates references to objects
@@ -4178,20 +4137,180 @@ package body Exp_Ch7 is
             --  machinery to manage the secondary stack (see routine
             --  Process_Statements_For_Controlled_Objects).
 
-            Iter_Loop := Find_Enclosing_Iterator_Loop (Current_Scope);
+            Iter_Loop := Find_Enclosing_Iterator_Loop (Trans_Scop);
 
             if Present (Iter_Loop) then
                Set_Uses_Sec_Stack (Iter_Loop);
             end if;
          end if;
 
-         Set_Etype (Current_Scope, Standard_Void_Type);
-         Set_Node_To_Be_Wrapped (Wrap_Node);
-
          if Debug_Flag_W then
             Write_Str ("    <Transient>");
             Write_Eol;
          end if;
+      end Create_Transient_Scope;
+
+      -----------------------------------
+      -- Delegate_Sec_Stack_Management --
+      -----------------------------------
+
+      procedure Delegate_Sec_Stack_Management is
+         Scop_Id  : Entity_Id;
+         Scop_Rec : Scope_Stack_Entry;
+
+      begin
+         for Index in reverse Scope_Stack.First .. Scope_Stack.Last loop
+            Scop_Rec := Scope_Stack.Table (Index);
+            Scop_Id  := Scop_Rec.Entity;
+
+            --  Prevent the search from going too far or within the scope space
+            --  of another unit.
+
+            if Scop_Id = Standard_Standard then
+               return;
+
+            --  No transient scope should be encountered during the traversal
+            --  because Establish_Transient_Scope should have already handled
+            --  this case.
+
+            elsif Scop_Rec.Is_Transient then
+               pragma Assert (False);
+               return;
+
+            --  The construct which requires secondary stack management is
+            --  always enclosed by a package or subprogram scope.
+
+            elsif Is_Package_Or_Subprogram (Scop_Id) then
+               Set_Uses_Sec_Stack (Scop_Id);
+               Check_Restriction (No_Secondary_Stack, N);
+
+               return;
+            end if;
+         end loop;
+
+         --  At this point no suitable scope was found. This should never occur
+         --  because a construct is always enclosed by a compilation unit which
+         --  has a scope.
+
+         pragma Assert (False);
+      end Delegate_Sec_Stack_Management;
+
+      ------------------------------------
+      -- Find_Enclosing_Transient_Scope --
+      ------------------------------------
+
+      function Find_Enclosing_Transient_Scope return Entity_Id is
+         Scop_Id   : Entity_Id;
+         Scop_Rec  : Scope_Stack_Entry;
+
+      begin
+         for Index in reverse Scope_Stack.First .. Scope_Stack.Last loop
+            Scop_Rec := Scope_Stack.Table (Index);
+            Scop_Id  := Scop_Rec.Entity;
+
+            --  Prevent the search from going too far or within the scope space
+            --  of another unit.
+
+            if Scop_Id = Standard_Standard
+              or else Is_Package_Or_Subprogram (Scop_Id)
+            then
+               exit;
+
+            elsif Scop_Rec.Is_Transient then
+               return Scop_Id;
+            end if;
+         end loop;
+
+         return Empty;
+      end Find_Enclosing_Transient_Scope;
+
+      ---------------------
+      -- Is_OK_Construct --
+      ---------------------
+
+      function Is_OK_Construct (Constr : Node_Id) return Boolean is
+      begin
+         --  Nothing to do when there is no construct to consider
+
+         if No (Constr) then
+            return False;
+
+         --  Nothing to do when the construct is an iteration scheme or an Ada
+         --  2012 iterator because the expression is one of the bounds, and the
+         --  expansion will create an explicit declaration for it (see routine
+         --  Analyze_Iteration_Scheme).
+
+         elsif Nkind_In (Constr, N_Iteration_Scheme,
+                                 N_Iterator_Specification)
+         then
+            return False;
+
+         --  Nothing to do in formal verification mode when the construct is
+         --  pragma Check, because the pragma remains unexpanded.
+
+         elsif GNATprove_Mode
+           and then Nkind (Constr) = N_Pragma
+           and then Get_Pragma_Id (Constr) = Pragma_Check
+         then
+            return False;
+         end if;
+
+         return True;
+      end Is_OK_Construct;
+
+      ------------------------------
+      -- Is_Package_Or_Subprogram --
+      ------------------------------
+
+      function Is_Package_Or_Subprogram (Id : Entity_Id) return Boolean is
+      begin
+         return Ekind_In (Id, E_Entry,
+                              E_Entry_Family,
+                              E_Function,
+                              E_Package,
+                              E_Procedure,
+                              E_Subprogram_Body);
+      end Is_Package_Or_Subprogram;
+
+      --  Local variables
+
+      Scop_Id : constant Entity_Id := Find_Enclosing_Transient_Scope;
+      Constr  : Node_Id;
+
+   --  Start of processing for Establish_Transient_Scope
+
+   begin
+      --  Do not create a new transient scope if there is an existing transient
+      --  scope on the stack.
+
+      if Present (Scop_Id) then
+
+         --  If the transient scope was requested for purposes of managing the
+         --  secondary stack, then the existing scope must perform this task.
+
+         if Manage_Sec_Stack then
+            Set_Uses_Sec_Stack (Scop_Id);
+         end if;
+
+         return;
+      end if;
+
+      --  At this point it is known that the scope stack is free of transient
+      --  scopes. Locate the proper construct which must be serviced by a new
+      --  transient scope.
+
+      Constr := Find_Node_To_Be_Wrapped (N);
+
+      if Is_OK_Construct (Constr) then
+         Create_Transient_Scope (Constr);
+
+      --  Otherwise there is no suitable construct which requires handling by
+      --  a transient scope. If the transient scope was requested for purposes
+      --  of managing the secondary stack, delegate the work to an enclosing
+      --  scope.
+
+      elsif Manage_Sec_Stack then
+         Delegate_Sec_Stack_Management;
       end if;
    end Establish_Transient_Scope;
 
@@ -4701,70 +4820,35 @@ package body Exp_Ch7 is
    -----------------------------
 
    function Find_Node_To_Be_Wrapped (N : Node_Id) return Node_Id is
-      P          : Node_Id;
-      The_Parent : Node_Id;
+      Curr : Node_Id;
+      Prev : Node_Id;
 
    begin
-      The_Parent := N;
-      P          := Empty;
+      Curr := N;
+      Prev := Empty;
       loop
-         case Nkind (The_Parent) is
-
-            --  Simple statement can be wrapped
-
-            when N_Pragma =>
-               return The_Parent;
-
-            --  Usually assignments are good candidate for wrapping except
-            --  when they have been generated as part of a controlled aggregate
-            --  where the wrapping should take place more globally. Note that
-            --  No_Ctrl_Actions may be set also for non-controlled assignements
-            --  in order to disable the use of dispatching _assign, so we need
-            --  to test explicitly for a controlled type here.
+         case Nkind (Curr) is
 
-            when N_Assignment_Statement =>
-               if No_Ctrl_Actions (The_Parent)
-                 and then Needs_Finalization (Etype (Name (The_Parent)))
-               then
-                  null;
-               else
-                  return The_Parent;
-               end if;
-
-            --  An entry call statement is a special case if it occurs in the
-            --  context of a Timed_Entry_Call. In this case we wrap the entire
-            --  timed entry call.
-
-            when N_Entry_Call_Statement
-               | N_Procedure_Call_Statement
-            =>
-               if Nkind (Parent (The_Parent)) = N_Entry_Call_Alternative
-                 and then Nkind_In (Parent (Parent (The_Parent)),
-                                    N_Timed_Entry_Call,
-                                    N_Conditional_Entry_Call)
-               then
-                  return Parent (Parent (The_Parent));
-               else
-                  return The_Parent;
-               end if;
+            --  Declarations
 
-            --  Object declarations are also a boundary for the transient scope
-            --  even if they are not really wrapped. For further details, see
-            --  Wrap_Transient_Declaration.
+            --  Declarations act as a boundary for a transient scope even if
+            --  they are not wrapped, see Wrap_Transient_Declaration.
 
             when N_Object_Declaration
                | N_Object_Renaming_Declaration
                | N_Subtype_Declaration
             =>
-               return The_Parent;
+               return Curr;
+
+            --  Statements
 
-            --  The expression itself is to be wrapped if its parent is a
-            --  compound statement or any other statement where the expression
-            --  is known to be scalar.
+            --  Statements and statement-like constructs act as a boundary for
+            --  a transient scope.
 
             when N_Accept_Alternative
                | N_Attribute_Definition_Clause
                | N_Case_Statement
+               | N_Case_Statement_Alternative
                | N_Code_Statement
                | N_Delay_Alternative
                | N_Delay_Until_Statement
@@ -4777,32 +4861,77 @@ package body Exp_Ch7 is
                | N_Iteration_Scheme
                | N_Terminate_Alternative
             =>
-               pragma Assert (Present (P));
-               return P;
+               pragma Assert (Present (Prev));
+               return Prev;
 
-            when N_Attribute_Reference =>
-               if Is_Procedure_Attribute_Name
-                    (Attribute_Name (The_Parent))
+            --  Assignment statements are usually wrapped in a transient block
+            --  except when they are generated as part of controlled aggregate
+            --  where the wrapping should take place more globally. Note that
+            --  No_Ctrl_Actions is set also for non-controlled assignments, in
+            --  order to disable the use of dispatching _assign, thus the test
+            --  for a controlled type.
+
+            when N_Assignment_Statement =>
+               if No_Ctrl_Actions (Curr)
+                 and then Needs_Finalization (Etype (Name (Curr)))
                then
-                  return The_Parent;
+                  return Empty;
+               else
+                  return Curr;
                end if;
 
-            --  A raise statement can be wrapped. This will arise when the
-            --  expression in a raise_with_expression uses the secondary
-            --  stack, for example.
+            --  An entry of procedure call is usually wrapped except when it
+            --  acts as the alternative of a conditional or timed entry call.
+            --  In that case wrap the context of the alternative.
 
-            when N_Raise_Statement =>
-               return The_Parent;
+            when N_Entry_Call_Statement
+               | N_Procedure_Call_Statement
+            =>
+               if Nkind (Parent (Curr)) = N_Entry_Call_Alternative
+                 and then Nkind_In (Parent (Parent (Curr)),
+                                    N_Conditional_Entry_Call,
+                                    N_Timed_Entry_Call)
+               then
+                  return Parent (Parent (Curr));
+               else
+                  return Curr;
+               end if;
+
+            when N_Pragma
+               | N_Raise_Statement
+            =>
+               return Curr;
 
-            --  If the expression is within the iteration scheme of a loop,
-            --  we must create a declaration for it, followed by an assignment
-            --  in order to have a usable statement to wrap.
+            --  A return statement is not wrapped when the associated function
+            --  would require wrapping.
+
+            when N_Simple_Return_Statement =>
+               if Requires_Transient_Scope (Etype
+                    (Return_Applies_To (Return_Statement_Entity (Curr))))
+               then
+                  return Empty;
+               else
+                  return Curr;
+               end if;
+
+            --  Special
+
+            when N_Attribute_Reference =>
+               if Is_Procedure_Attribute_Name (Attribute_Name (Curr)) then
+                  return Curr;
+               end if;
+
+            --  If the construct is within the iteration scheme of a loop, it
+            --  requires a declaration followed by an assignment, in order to
+            --  have a usable statement to wrap.
 
             when N_Loop_Parameter_Specification =>
-               return Parent (The_Parent);
+               return Parent (Curr);
 
-            --  The following nodes contains "dummy calls" which don't need to
-            --  be wrapped.
+            --  Termination
+
+            --  The following nodes represent "dummy contexts" which do not
+            --  need to be wrapped.
 
             when N_Component_Declaration
                | N_Discriminant_Specification
@@ -4810,43 +4939,29 @@ package body Exp_Ch7 is
             =>
                return Empty;
 
-            --  The return statement is not to be wrapped when the function
-            --  itself needs wrapping at the outer-level
-
-            when N_Simple_Return_Statement =>
-               declare
-                  Applies_To : constant Entity_Id :=
-                                 Return_Applies_To
-                                   (Return_Statement_Entity (The_Parent));
-                  Return_Type : constant Entity_Id := Etype (Applies_To);
-               begin
-                  if Requires_Transient_Scope (Return_Type) then
-                     return Empty;
-                  else
-                     return The_Parent;
-                  end if;
-               end;
-
-            --  If we leave a scope without having been able to find a node to
-            --  wrap, something is going wrong but this can happen in error
-            --  situation that are not detected yet (such as a dynamic string
-            --  in a pragma export)
+            --  If the traversal leaves a scope without having been able to
+            --  find a construct to wrap, something is going wrong, but this
+            --  can happen in error situations that are not detected yet (such
+            --  as a dynamic string in a pragma Export).
 
             when N_Block_Statement
+               | N_Entry_Body
                | N_Package_Body
                | N_Package_Declaration
+               | N_Protected_Body
                | N_Subprogram_Body
+               | N_Task_Body
             =>
                return Empty;
 
-            --  Otherwise continue the search
+            --  Default
 
             when others =>
                null;
          end case;
 
-         P          := The_Parent;
-         The_Parent := Parent (P);
+         Prev := Curr;
+         Curr := Parent (Curr);
       end loop;
    end Find_Node_To_Be_Wrapped;