exp_ch7.ads, [...] (Find_Final_List): If the access type is anonymous, use…

exp_ch7.ads, [...] (Find_Final_List): If the access type is anonymous, use finalization list of enclosing dynamic scope.

2007-04-06  Ed Schonberg  <schonberg@adacore.com>
	    Bob Duff  <duff@adacore.com>
	    Cyrille Comar  <comar@adacore.com>

	* exp_ch7.ads, exp_ch7.adb (Find_Final_List): If the access type is
	anonymous, use finalization list of enclosing dynamic scope.
	(Expand_N_Package_Declaration): For a library package declaration
	without a corresponding body, generate RACW subprogram bodies in the
	spec (just as we do for the task activation call).
	(Convert_View): Split Is_Abstract flag into Is_Abstract_Subprogram and
	Is_Abstract_Type. Make sure these are called only when appropriate.
	Remove all code for DSP option
	(CW_Or_Controlled_Type): new subprogram.

From-SVN: r123563

gcc/ada/exp_ch7.adb

@@ -35,9 +35,11 @@ with Errout;   use Errout;
 with Exp_Ch9;  use Exp_Ch9;
 with Exp_Ch11; use Exp_Ch11;
 with Exp_Dbug; use Exp_Dbug;
+with Exp_Dist; use Exp_Dist;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
 with Freeze;   use Freeze;
+with Lib;      use Lib;
 with Hostparm; use Hostparm;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
@@ -46,7 +48,6 @@ with Output;   use Output;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
-with Targparm; use Targparm;
 with Sinfo;    use Sinfo;
 with Sem;      use Sem;
 with Sem_Ch3;  use Sem_Ch3;
@@ -900,6 +901,15 @@ package body Exp_Ch7 is
                    and then Controlled_Type (Corresponding_Record_Type (T)));
    end Controlled_Type;
 
+   ---------------------------
+   -- CW_Or_Controlled_Type --
+   ---------------------------
+
+   function CW_Or_Controlled_Type (T : Entity_Id) return Boolean is
+   begin
+      return Is_Class_Wide_Type (T) or else Controlled_Type (T);
+   end CW_Or_Controlled_Type;
+
    --------------------------
    -- Controller_Component --
    --------------------------
@@ -977,7 +987,7 @@ package body Exp_Ch7 is
          Atyp := Etype (Arg);
       end if;
 
-      if Is_Abstract (Proc) and then Is_Tagged_Type (Ftyp) then
+      if Is_Abstract_Subprogram (Proc) and then Is_Tagged_Type (Ftyp) then
          return Unchecked_Convert_To (Class_Wide_Type (Ftyp), Arg);
 
       elsif Ftyp /= Atyp
@@ -1020,17 +1030,12 @@ package body Exp_Ch7 is
       Loc       : constant Source_Ptr := Sloc (N);
       Wrap_Node : Node_Id;
 
-      Sec_Stk : constant Boolean :=
-                  Sec_Stack and not Functions_Return_By_DSP_On_Target;
-      --  We never need a secondary stack if functions return by DSP
-
    begin
       --  Do not create a transient scope if we are already inside one
 
       for S in reverse Scope_Stack.First .. Scope_Stack.Last loop
-
          if Scope_Stack.Table (S).Is_Transient then
-            if Sec_Stk then
+            if Sec_Stack then
                Set_Uses_Sec_Stack (Scope_Stack.Table (S).Entity);
             end if;
 
@@ -1064,7 +1069,7 @@ package body Exp_Ch7 is
          New_Scope (New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'));
          Set_Scope_Is_Transient;
 
-         if Sec_Stk then
+         if Sec_Stack then
             Set_Uses_Sec_Stack (Current_Scope);
             Check_Restriction (No_Secondary_Stack, N);
          end if;
@@ -1546,12 +1551,12 @@ package body Exp_Ch7 is
    -- Expand_N_Package_Body --
    ---------------------------
 
-   --  Add call to Activate_Tasks if body is an activator (actual
-   --  processing is in chapter 9).
+   --  Add call to Activate_Tasks if body is an activator (actual processing
+   --  is in chapter 9).
 
    --  Generate subprogram descriptor for elaboration routine
 
-   --  ENcode entity names in package body
+   --  Encode entity names in package body
 
    procedure Expand_N_Package_Body (N : Node_Id) is
       Ent : constant Entity_Id := Corresponding_Spec (N);
@@ -1583,14 +1588,76 @@ package body Exp_Ch7 is
    --  whether a body will eventually appear.
 
    procedure Expand_N_Package_Declaration (N : Node_Id) is
+      Spec    : constant Node_Id := Specification (N);
+      Decls   : List_Id;
+
+      No_Body : Boolean;
+      --  True in the case of a package declaration that is a compilation unit
+      --  and for which no associated body will be compiled in
+      --  this compilation.
    begin
-      if Nkind (Parent (N)) = N_Compilation_Unit
-        and then not Body_Required (Parent (N))
+
+      No_Body := False;
+
+      --  Case of a package declaration other than a compilation unit
+
+      if Nkind (Parent (N)) /= N_Compilation_Unit then
+         null;
+
+      --  Case of a compilation unit that does not require a body
+
+      elsif not Body_Required (Parent (N))
         and then not Unit_Requires_Body (Defining_Entity (N))
-        and then Present (Activation_Chain_Entity (N))
       then
+         No_Body := True;
+
+      --  Special case of generating calling stubs for a remote call interface
+      --  package: even though the package declaration requires one, the
+      --  body won't be processed in this compilation (so any stubs for RACWs
+      --  declared in the package must be generated here, along with the
+      --  spec).
+
+      elsif Parent (N) = Cunit (Main_Unit)
+        and then Is_Remote_Call_Interface (Defining_Entity (N))
+        and then Distribution_Stub_Mode = Generate_Caller_Stub_Body
+      then
+         No_Body := True;
+      end if;
+
+      --  For a package declaration that implies no associated body, generate
+      --  task activation call and RACW supporting bodies now (since we won't
+      --  have a specific separate compilation unit for that).
+
+      if No_Body then
+
          New_Scope (Defining_Entity (N));
+
+         if Has_RACW (Defining_Entity (N)) then
+
+            --  Generate RACW subprogram bodies
+
+            Decls := Private_Declarations (Spec);
+
+            if No (Decls) then
+               Decls := Visible_Declarations (Spec);
+            end if;
+
+            if No (Decls) then
+               Decls := New_List;
+               Set_Visible_Declarations (Spec, Decls);
+            end if;
+
+            Append_RACW_Bodies (Decls, Defining_Entity (N));
+            Analyze_List (Decls);
+         end if;
+
+         if Present (Activation_Chain_Entity (N)) then
+
+            --  Generate task activation call as last step of elaboration
+
             Build_Task_Activation_Call (N);
+         end if;
+
          Pop_Scope;
       end if;
 
@@ -1652,12 +1719,18 @@ package body Exp_Ch7 is
              Selector_Name => Make_Identifier (Loc, Name_F));
 
       --  Case of a dynamically allocated object. The final list is the
-      --  corresponding list controller (The next entity in the scope of
-      --  the access type with the right type). If the type comes from a
-      --  With_Type clause, no controller was created, and we use the
-      --  global chain instead.
+      --  corresponding list controller (the next entity in the scope of the
+      --  access type with the right type). If the type comes from a With_Type
+      --  clause, no controller was created, we use the global chain instead.
 
-      elsif Is_Access_Type (E) then
+      --  An anonymous access type either has a list created for it when the
+      --  allocator is a for an access parameter or an access discriminant,
+      --  or else it uses the list of the enclosing dynamic scope, when the
+      --  context is a declaration or an assignment.
+
+      elsif Is_Access_Type (E)
+        and then Ekind (E) /= E_Anonymous_Access_Type
+      then
          if not From_With_Type (E) then
             return
               Make_Selected_Component (Loc,
@@ -2589,7 +2662,7 @@ package body Exp_Ch7 is
 
       if Prim = Finalize_Case or else Prim = Adjust_Case then
          Handler := New_List (
-           Make_Exception_Handler (Loc,
+           Make_Implicit_Exception_Handler (Loc,
              Exception_Choices => New_List (Make_Others_Choice (Loc)),
              Statements        => New_List (
                Make_Raise_Program_Error (Loc,
@@ -3025,11 +3098,9 @@ package body Exp_Ch7 is
                   Set_Uses_Sec_Stack (Current_Scope, False);
 
                   if not Requires_Transient_Scope (Etype (S)) then
-                     if not Functions_Return_By_DSP_On_Target then
                      Set_Uses_Sec_Stack (S, True);
                      Check_Restriction (No_Secondary_Stack, Action);
                   end if;
-                  end if;
 
                   exit;
 
@@ -3046,11 +3117,8 @@ package body Exp_Ch7 is
                elsif K = E_Procedure
                  or else K = E_Block
                then
-                  if not Functions_Return_By_DSP_On_Target then
                   Set_Uses_Sec_Stack (S, True);
                   Check_Restriction (No_Secondary_Stack, Action);
-                  end if;
-
                   Set_Uses_Sec_Stack (Current_Scope, False);
                   exit;
 

gcc/ada/exp_ch7.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -60,15 +60,21 @@ package Exp_Ch7 is
    function Controlled_Type (T : Entity_Id) return Boolean;
    --  True if T potentially needs finalization actions
 
+   function CW_Or_Controlled_Type (T : Entity_Id) return Boolean;
+   --  True if T is either a potentially controlled type or a class-wide type.
+   --  Note that in normal mode, class-wide types are potentially controlled so
+   --  this function is different from Controlled_Type only under restrictions
+   --  No_Finalization.
+
    function Find_Final_List
      (E   : Entity_Id;
       Ref : Node_Id := Empty) return Node_Id;
-   --  E is an entity representing a controlled object, a controlled type
-   --  or a scope. If Ref is not empty, it is a reference to a controlled
-   --  record, the closest Final list is in the controller component of
-   --  the record containing Ref otherwise this function returns a
-   --  reference to the final list attached to the closest dynamic scope
-   --  (that can be E itself) creating this final list if necessary.
+   --  E is an entity representing a controlled object, a controlled type or a
+   --  scope. If Ref is not empty, it is a reference to a controlled record,
+   --  the closest Final list is in the controller component of the record
+   --  containing Ref otherwise this function returns a reference to the final
+   --  list attached to the closest dynamic scope (that can be E itself)
+   --  creating this final list if necessary.
 
    function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
    --  E is a type entity. Give the same resul as Has_Controlled_Component
@@ -79,30 +85,28 @@ package Exp_Ch7 is
      (Obj_Ref     : Node_Id;
       Flist_Ref   : Node_Id;
       With_Attach : Node_Id) return Node_Id;
-   --  Attach the referenced object to the referenced Final Chain
-   --  'Flist_Ref' With_Attach is an expression of type Short_Short_Integer
-   --  which can be either '0' to signify no attachment, '1' for
-   --  attachement to a simply linked list or '2' for attachement to a
-   --  doubly linked list.
+   --  Attach the referenced object to the referenced Final Chain 'Flist_Ref'
+   --  With_Attach is an expression of type Short_Short_Integer which can be
+   --  either '0' to signify no attachment, '1' for attachement to a simply
+   --  linked list or '2' for attachement to a doubly linked list.
 
    function Make_Init_Call
      (Ref         : Node_Id;
       Typ         : Entity_Id;
       Flist_Ref   : Node_Id;
       With_Attach : Node_Id) return List_Id;
-   --  Ref is an expression (with no-side effect and is not required to
-   --  have been previously analyzed) that references the object to be
-   --  initialized. Typ is the expected type of Ref, which is a controlled
-   --  type (Is_Controlled) or a type with controlled components
-   --  (Has_Controlled). With_Attach is an integer expression representing
-   --  the level of attachment, see Attach_To_Final_List's Nb_Link param
-   --  documentation in s-finimp.ads.
+   --  Ref is an expression (with no-side effect and is not required to have
+   --  been previously analyzed) that references the object to be initialized.
+   --  Typ is the expected type of Ref, which is either a controlled type
+   --  (Is_Controlled) or a type with controlled components (Has_Controlled).
+   --  With_Attach is an integer expression which is the attchment level,
+   --  see System.Finalization_Implementation.Attach_To_Final_List for the
+   --  documentation of Nb_Link.
    --
-   --  This function will generate the appropriate calls to make
-   --  sure that the objects referenced by Ref are initialized. The
-   --  generate code is quite different depending on the fact the type
-   --  IS_Controlled or HAS_Controlled but this is not the problem of the
-   --  caller, the details are in the body.
+   --  This function will generate the appropriate calls to make sure that the
+   --  objects referenced by Ref are initialized. The generated code is quite
+   --  different for an IS_Controlled type or a HAS_Controlled type, but this
+   --  is not the problem for the caller, the details are in the body.
 
    function Make_Adjust_Call
      (Ref         : Node_Id;
@@ -110,23 +114,23 @@ package Exp_Ch7 is
       Flist_Ref   : Node_Id;
       With_Attach : Node_Id;
       Allocator   : Boolean := False) return List_Id;
-   --  Ref is an expression (with no-side effect and is not required to
-   --  have been previously analyzed) that references the object to be
-   --  adjusted. Typ is the expected type of Ref, which is a controlled
-   --  type (Is_Controlled) or a type with controlled components
-   --  (Has_Controlled).  With_Attach is an integer expression representing
-   --  the level of attachment, see Attach_To_Final_List's Nb_Link param
-   --  documentation in s-finimp.ads. Note: if Typ is Finalize_Storage_Only
-   --  and the object is at library level, then With_Attach will be ignored,
-   --  and a zero link level will be passed to Attach_To_Final_List.
+   --  Ref is an expression (with no-side effect and is not required to have
+   --  been previously analyzed) that references the object to be adjusted. Typ
+   --  is the expected type of Ref, which is a controlled type (Is_Controlled)
+   --  or a type with controlled components (Has_Controlled). With_Attach is an
+   --  integer expression giving the attachment level (see documentation of
+   --  Attach_To_Final_List.Nb_Link param documentation in s-finimp.ads.
+   --  Note: if Typ is Finalize_Storage_Only and the object is at library
+   --  level, then With_Attach will be ignored, and a zero link level will be
+   --  passed to Attach_To_Final_List.
    --
-   --  This function will generate the appropriate calls to make
-   --  sure that the objects referenced by Ref are adjusted. The generated
-   --  code is quite different depending on the fact the type IS_Controlled
-   --  or HAS_Controlled but this is not the problem of the caller, the
-   --  details are in the body. The objects must be attached when the adjust
-   --  takes place after an initialization expression but not when it takes
-   --  place after a regular assignment.
+   --  This function will generate the appropriate calls to make sure that the
+   --  objects referenced by Ref are adjusted. The generated code is quite
+   --  different depending on the fact the type IS_Controlled or HAS_Controlled
+   --  but this is not the problem of the caller, the details are in the body.
+   --  The objects must be attached when the adjust takes place after an
+   --  initialization expression but not when it takes place after a regular
+   --  assignment.
    --
    --  If Allocator is True, we are adjusting a newly-created object. The
    --  existing chaining pointers should not be left unchanged, because they
@@ -138,21 +142,21 @@ package Exp_Ch7 is
      (Ref         : Node_Id;
       Typ         : Entity_Id;
       With_Detach : Node_Id) return List_Id;
-   --  Ref is an expression (with no-side effect and is not required
-   --  to have been previously analyzed) that references the object to
-   --  be Finalized. Typ is the expected type of Ref, which is a
-   --  controlled type (Is_Controlled) or a type with controlled
-   --  components (Has_Controlled). With_Detach is a boolean expression
-   --  indicating whether to detach the controlled object from whatever
-   --  finalization list it is currently attached to.
+   --  Ref is an expression (with no-side effect and is not required to have
+   --  been previously analyzed) that references the object to be Finalized.
+   --  Typ is the expected type of Ref, which is a controlled type
+   --  (Is_Controlled) or a type with controlled components (Has_Controlled).
+   --  With_Detach is a boolean expression indicating whether to detach the
+   --  controlled object from whatever finalization list it is currently
+   --  attached to.
    --
-   --  This function will generate the appropriate calls to make
-   --  sure that the objects referenced by Ref are finalized. The generated
-   --  code is quite different depending on the fact the type IS_Controlled
-   --  or HAS_Controlled but this is not the problem of the caller, the
-   --  details are in the body. The objects must be detached when finalizing
-   --  an unchecked deallocated object but not when finalizing the target of
-   --  an assignment, it is not necessary either on scope exit.
+   --  This function will generate the appropriate calls to make sure that the
+   --  objects referenced by Ref are finalized. The generated code is quite
+   --  different depending on the fact the type IS_Controlled or HAS_Controlled
+   --  but this is not the problem of the caller, the details are in the body.
+   --  The objects must be detached when finalizing an unchecked deallocated
+   --  object but not when finalizing the target of an assignment, it is not
+   --  necessary either on scope exit.
 
    procedure Expand_Ctrl_Function_Call (N : Node_Id);
    --  Expand a call to a function returning a controlled value. That is to
@@ -167,8 +171,8 @@ package Exp_Ch7 is
      (N   : Node_Id;
       Obj : Node_Id;
       Typ : Entity_Id) return List_Id;
-   --  Generate loops to finalize any tasks or simple protected objects
-   --  that are subcomponents of an array.
+   --  Generate loops to finalize any tasks or simple protected objects that
+   --  are subcomponents of an array.
 
    function Cleanup_Protected_Object
      (N   : Node_Id;
@@ -191,10 +195,10 @@ package Exp_Ch7 is
    --  Check whether composite type contains a simple protected component
 
    function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
-   --  Check whether argument is a protected type without entries.
-   --  Protected types with entries are controlled, and their cleanup
-   --  is handled by the standard finalization machinery. For simple
-   --  protected types we generate inline code to release their locks.
+   --  Check whether argument is a protected type without entries. Protected
+   --  types with entries are controlled, and their cleanup is handled by the
+   --  standard finalization machinery. For simple protected types we generate
+   --  inline code to release their locks.
 
    --------------------------------
    -- Transient Scope Management --
@@ -215,12 +219,12 @@ package Exp_Ch7 is
    --  return the node to be wrapped if the current scope is transient
 
    procedure Store_Before_Actions_In_Scope (L : List_Id);
-   --  Append the list L of actions to the end of the before-actions store
-   --  in the top of the scope stack
+   --  Append the list L of actions to the end of the before-actions store in
+   --  the top of the scope stack
 
    procedure Store_After_Actions_In_Scope (L : List_Id);
-   --  Append the list L of actions to the beginning of the after-actions
-   --  store in the top of the scope stack
+   --  Append the list L of actions to the beginning of the after-actions store
+   --  in the top of the scope stack
 
    procedure Wrap_Transient_Declaration (N : Node_Id);
    --  N is an object declaration. Expand the finalization calls after the