2007-04-06 Robert Dewar <dewar@adacore.com>

	    Thomas Quinot  <quinot@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Bob Duff  <duff@adacore.com>

	* einfo.ads, einfo.adb: (First_Component_Or_Discriminant): New function
	(Next_Component_Or_Discriminant): New function and procedure
	(First_Index, First_Literal, Master_Id,
	Set_First_Index, Set_First_Literal, Set_Master_Id):
	Add missing Ekind assertions.
	(Is_Access_Protected_Subprogram_Type): New predicate.
	(Has_RACW): New entity flag, set on package entities to indicate that
	the package contains the declaration of a remote accecss-to-classwide
	type.
	(E_Return_Statement): This node type has the Finalization_Chain_Entity
	attribute, in case the result type has controlled parts.
	(Requires_Overriding): Add this new flag, because "requires
	overriding" is subtly different from "is abstract" (see AI-228).
	(Is_Abstract): Split Is_Abstract flag into Is_Abstract_Subprogram and
	Is_Abstract_Type. Make sure these are called only when appropriate.
	(Has_Pragma_Unreferenced_Objects): New flag

	* exp_ch5.adb (Expand_N_Assignment_Statement): If the left-hand side is
	class-wide, the tag of the right-hand side must be an exact match, not
	an ancestor of that of the object on left-hand side.
	(Move_Activation_Chain): New procedure to create the call to
	System.Tasking.Stages.Move_Activation_Chain.
	(Expand_N_Extended_Return_Statement): Generate code to call
	System.Finalization_Implementation.Move_Final_List at the end of a
	return statement if the function's result type has controlled parts.
	Move asserts to Build_In_Place_Formal.
	(Move_Final_List): New function to create the call statement.
	(Expand_N_Assignment_Statement): In case of assignment to a class-wide
	tagged type, replace generation of call to the run-time subprogram
	CW_Membership by call to Build_CW_Membership.
	(Expand_N_Return_Statement): Replace generation of call to the run-time
	subprogram Get_Access_Level by call to Build_Get_Access_Level.
	(Expand_N_Simple_Function_Return): Replace generation of call to the
	run-time subprogram Get_Access_Level by call to Build_Get_Access_Level.

	* exp_ch6.ads, exp_ch6.adb (Expand_Call): Use new predicate
	Is_Access_Protected_Subprogram_Type, to handle both named and anonymous
	access to protected operations.
	(Add_Task_Actuals_To_Build_In_Place_Call): New procedure to add the
	master and chain actual parameters to a build-in-place function call
	involving tasks.
	(BIP_Formal_Suffix): Add new enumeration literals to complete the case
	statement.
	(Make_Build_In_Place_Call_In_Allocator,
	Make_Build_In_Place_Call_In_Anonymous_Context,
	Make_Build_In_Place_Call_In_Assignment,
	Make_Build_In_Place_Call_In_Object_Declaration): Call
	Add_Task_Actuals_To_Build_In_Place_Call with the appropriate master.
	(Expand_Inlined_Call): If the subprogram is a null procedure, or a
	stubbed procedure with a null body, replace the call with a null
	statement without using the full inlining machinery, for efficiency
	and to avoid invalid values in source file table entries.

	* exp_ch8.adb (Expand_N_Object_Renaming_Declaration): Add support for
	renamings of calls to build-in-place functions.

	* rtsfind.adb (RTE_Record_Component_Available): New subprogram that
	provides the functionality of RTE_Available to record components.
	(RTU_Entity): The function Entity has been renamed to RTU_Entity
	to avoid undesired overloading.
	(Entity): New subprogram that returns the entity for the referened
	unit. If this unit has not been loaded, it returns Empty.
	(RE_Activation_Chain_Access, RE_Move_Activation_Chain): New entities.
	Remove no longer used entities.
	(RE_Finalizable_Ptr_Ptr, RE_Move_Final_List): New entities.
	(RE_Type_Specific_Data): New entity.
	(RE_Move_Any_Value): New entity.
	(RE_TA_A, RE_Get_Any_Type): New entities.
	(RE_Access_Level, RE_Dispatch_Table, E_Default_Prim_Op_Count,
	 RE_Prims_Ptr, RE_RC_Offset, RE_Remotely_Callable,
	 RE_DT_Typeinfo_Ptr_Size, RE_Cstring_Ptr, RE_DT_Expanded_Name): Added.
	(Entity): New subprogram that returns the entity for the referened
	unit. If this unit has not been loaded, it returns Empty.
	(RTE): Addition of a new formal that extends the search to the scopes
	of the record types found in the chain of the package.

	* sem_ch6.ads, sem_ch6.adb (Check_Overriding_Indicator): Print
	"abstract subprograms must be visible" message, whether or not the type
	is an interface; that is, remove the special case for interface types.
	(Analyze_Function_Return): Remove error message "return of task objects
	is not yet implemented" because this is now implemented.
	(Create_Extra_Formals): Add the extra master and activation chain
	formals in case the result type has tasks.
	Remove error message "return of limited controlled objects is not yet
	implemented".
	(Create_Extra_Formals): Add the extra caller's finalization list formal
	in case the result type has controlled parts.
	(Process_Formals): In case of access formal types there is no need
	to continue with the analysis of the formals if we already notified
	errors.
	(Check_Overriding_Indicator): Add code to check overriding of predefined
	operators.
	(Create_Extra_Formals): Prevent creation of useless Extra_Constrained
	flags for formals that do not require them,.
	(Enter_Overloaded_Entity): Do not give -gnatwh warning message unless
	hidden entity is use visible or directly visible.
	(Analyze_Abstract_Subprogram_Declaration,Analyze_Subprogram_Body,
	Analyze_Subprogram_Declaration,Analyze_Subprogram_Specification,
	Check_Conventions,Check_Delayed_Subprogram,Make_Inequality_Operator,
	New_Overloaded_Entity): Split Is_Abstract flag into
	Is_Abstract_Subprogram and Is_Abstract_Type.

	* s-finimp.ads, s-finimp.adb (Move_Final_List): New procedure to move
	a return statement's finalization list to the caller's list, used for
	build-in-place functions with result type with controlled parts.
	Remove no longer used entities.

	* s-taskin.ads (Activation_Chain): Remove pragma Volatile. It is no
	longer needed, because the full type is now limited, and therefore a
	pass-by-reference type.
	(Foreign_Task_Level): New constant.

	* s-tassta.ads, s-tassta.adb (Move_Activation_Chain): New procedure to
	move tasks from the activation chain belonging to a return statement to
	the one passed in by the caller, and update the master to the one
	passed in by the caller.
	(Vulnerable_Complete_Master, Check_Unactivated_Tasks): Check the master
	of unactivated tasks, so we don't kill the ones that are being returned
	by a build-in-place function.
	(Create_Task): Ignore AI-280 for foreign threads.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@123558 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 72 insertions, 7 deletions

diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index e0a6c946348..d6fe66c1f4e 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -149,6 +149,9 @@ package body System.Tasking.Stages is
    --  trigger an automatic stack alignment suitable for GCC's assumptions if
    --  need be.
 
+   --  "Vulnerable_..." in the procedure names below means they must be called
+   --  with abort deferred.
+
    procedure Vulnerable_Complete_Task (Self_ID : Task_Id);
    --  Complete the calling task. This procedure must be called with
    --  abort deferred. It should only be called by Complete_Task and
@@ -520,9 +523,11 @@ package body System.Tasking.Stages is
    begin
       --  If Master is greater than the current master, it means that Master
       --  has already awaited its dependent tasks. This raises Program_Error,
-      --  by 4.8(10.3/2). See AI-280.
+      --  by 4.8(10.3/2). See AI-280. Ignore this check for foreign threads.
 
-      if Master > Self_ID.Master_Within then
+      if Self_ID.Master_of_Task /= Foreign_Task_Level
+        and then Master > Self_ID.Master_Within
+      then
          raise Program_Error with
            "create task after awaiting termination";
       end if;
@@ -877,6 +882,53 @@ package body System.Tasking.Stages is
       end if;
    end Free_Task;
 
+   ---------------------------
+   -- Move_Activation_Chain --
+   ---------------------------
+
+   procedure Move_Activation_Chain
+     (From, To   : Activation_Chain_Access;
+      New_Master : Master_ID)
+   is
+      Self_ID : constant Task_Id := STPO.Self;
+      C       : Task_Id;
+
+   begin
+      pragma Debug
+        (Debug.Trace (Self_ID, "Move_Activation_Chain", 'C'));
+
+      --  Nothing to do if From is empty, and we can check that without
+      --  deferring aborts.
+
+      C := From.all.T_ID;
+
+      if C = null then
+         return;
+      end if;
+
+      Initialization.Defer_Abort (Self_ID);
+
+      --  Loop through the From chain, changing their Master_of_Task
+      --  fields, and to find the end of the chain.
+
+      loop
+         C.Master_of_Task := New_Master;
+         exit when C.Common.Activation_Link = null;
+         C := C.Common.Activation_Link;
+      end loop;
+
+      --  Hook From in at the start of To
+
+      C.Common.Activation_Link := To.all.T_ID;
+      To.all.T_ID := From.all.T_ID;
+
+      --  Set From to empty
+
+      From.all.T_ID := null;
+
+      Initialization.Undefer_Abort (Self_ID);
+   end Move_Activation_Chain;
+
    ------------------
    -- Task_Wrapper --
    ------------------
@@ -1407,7 +1459,7 @@ package body System.Tasking.Stages is
 
          C := All_Tasks_List;
          while C /= null loop
-            if C.Common.Activator = Self_ID then
+            if C.Common.Activator = Self_ID and then C.Master_of_Task = CM then
                return False;
             end if;
 
@@ -1449,13 +1501,24 @@ package body System.Tasking.Stages is
       --  zero for new tasks, and the task should not exit the
       --  sleep-loops that use this count until the count reaches zero.
 
+      --  While we're counting, if we run across any unactivated tasks that
+      --  belong to this master, we summarily terminate them as required by
+      --  RM-9.2(6).
+
       Lock_RTS;
       Write_Lock (Self_ID);
 
       C := All_Tasks_List;
       while C /= null loop
-         if C.Common.Activator = Self_ID then
+
+         --  Terminate unactivated (never-to-be activated) tasks
+
+         if C.Common.Activator = Self_ID and then C.Master_of_Task = CM then
             pragma Assert (C.Common.State = Unactivated);
+            --  Usually, C.Common.Activator = Self_ID implies C.Master_of_Task
+            --  = CM. The only case where C is pending activation by this
+            --  task, but the master of C is not CM is in Ada 2005, when C is
+            --  part of a return object of a build-in-place function.
 
             Write_Lock (C);
             C.Common.Activator := null;
@@ -1465,6 +1528,8 @@ package body System.Tasking.Stages is
             Unlock (C);
          end if;
 
+         --  Count it if dependent on this master
+
          if C.Common.Parent = Self_ID and then C.Master_of_Task = CM then
             Write_Lock (C);
 
@@ -1733,9 +1798,9 @@ package body System.Tasking.Stages is
 
    --  Complete the calling task
 
-   --  This procedure must be called with abort deferred. (That's why the
-   --  name has "Vulnerable" in it.) It should only be called by Complete_Task
-   --  and Finalize_Global_Tasks (for the environment task).
+   --  This procedure must be called with abort deferred. It should only be
+   --  called by Complete_Task and Finalize_Global_Tasks (for the environment
+   --  task).
 
    --  The effect is similar to that of Complete_Master. Differences include
    --  the closing of entries here, and computation of the number of active