2007-04-06 Javier Miranda <miranda@adacore.com>

	    Gary Dismukes  <dismukes@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* exp_ch13.adb (Expand_External_Tag_Definition): Replace call to the
	run-time subprogram Set_External_Tag by call to Build_Set_External_Tag.

	* exp_ch4.adb (Expand_Allocator_Expression): Don't perform a run-time
	accessibility on class-wide allocators if the allocator occurs at the
	same scope level as the allocator's type. The check is guaranteed to
	succeed in that case, even when the expression originates from a
	parameter of the containing subprogram.
	(Expand_N_Op_Eq): Do nothing in case of dispatching call if compiling
	under No_Dispatching_Calls restriction. During the semantic analysis
	we already notified such violation.
	(Tagged_Membership): Constant folding. There is no need to check
	the tag at run-time if the type of the right operand is non
	class-wide abstract.
	Replace call to Is_Ancestor by call to Is_Parent
	to support concurrent types with interface types.
	(Expand_N_Allocator): Add an assertion associated with the generation
	of the master_id.
	(Expand_N_Slice): Do not enable range check to nodes associated
	with the frontend expansion of the dispatch table.
	(Is_Local_Access_Discriminant): Subsidiary function to
	Expand_N_Allocator.
	(Tagged_Membership): Replace generation of call to the run-time
	subprogram CW_Membership by call to Build_CW_Membership.
	(Expand_Allocator_Expression): Replace generation of call to the
	run-time subprogram Get_Access_Level by call to Build_Get_Access_Level.

	* exp_disp.ads, exp_disp.adb (Make_DT): Code reorganization to
	initialize most the TSD components by means of an aggregate.
	Modify the declaration of the object containing the TSD
	because we now expand code that has a higher level of abstraction.
	The TSD has a discriminant containing the Inheritance Depth Level,
	value that is used in the membership test but also to fix the size
	of the table of ancestors.
	(Expand_Interface_Conversion): Insert function body at the closest place
	to the conversion expression, to prevent access-before-elaboration
	errors in the backend.
	Code improved to reduce the size of the dispatch table if
	compiling under restriction No_Dispatching_Calls plus code cleanup.
	Code reorganization plus removal of calls to Set_Num_Prim_Ops
	(Make_Secondary_DT): Remove call to Set_Num_Prim_Ops.
	(Expand_Dispatching_Call): Minor code reorganization plus addition of
	code to return immediately if compiling under No_Dispatching_Calls
	restriction.
	(Set_All_DT_Position): Remove code associated with the old CPP pragmas.
	CPP_Virtual and CPP_Vtable are no longer supported.
	(Expand_Interface_Conversion): Add missing support for interface type
	derivations.
	(Expand_Interface_Actuals): Replace calls to Is_Ancestor by calls to
	Is_Parent to support concurrent types with interfaces.
	(Init_Predefined_Interface_Primitives): Removed.
	(Make_Secondary_DT): Modified to support concurrent record types.
	(Set_All_DT_Position): Modified to support concurrent record types.
	(Ada_Actions, Action_Is_Proc, Action_Nb_Arg): Remove entries associated
	with Get_External_Tag, Inherit_TSD, Set_External_Tag.
	(Ada_Actions, Action_Is_Proc, Action_Nb_Arg): Remove entry associated
	with CW_Membership.
	(Ada_Actions, Action_Is_Proc, Action_Nb_Arg): Remove entries associated
	with Get_Access_Level, Get_Predefined_Prim_Op_Address,
	Get_Prim_Op_Address Get_RC_Offset, Get_Remotely_Callable, Inherit_DT,
	Set_Access_Level, Set_Expanded_Name, Set_Predefined_Prim_Op_Address,
	Set_Prim_Op_Address, Set_RC_Offset, Set_Remotely_Callable, Set_TSD.
	(Expand_Dispatching_Call): Replace generation of call to the run-time
	subprograms Get_Predefined_Prim_Op_Address and Get_Prim_Op_Address by
	calls to Build_Get_Predefined_Prim_Op_Address, and Build_Get_Prim_Op_
	Address.
	(Fill_DT_Entry, Fill_Secondary_DT_Entry): Replace generation of call to
	the run-time subprograms Set_Predefined_Prim_Op_Address and Set_Prim_
	Op_Address by calls to Build_Set_Predefined_Prim_Op_Address, and
	Build_Set_Prim_Op_Address.
	(Get_Remotely_Callable): Subprogram removed.
	(Init_Predefined_Interface_Primitives): Replace generation of call to
	the run-time subprograms Inherit_DT by call to Build_Inherit_Predefined_
	Prims.

	* sem_elab.adb (Set_Elaboration_Constraint): Replace the call to
	First (Parameter_Associations ()) with the call to First_Actual that
	returns an actual parameter expression for both named and positional
	associations.

	* sem_disp.adb (Check_Dispatching_Call): In case of dispatching call
	check violation of restriction No_Dispatching_Calls.
	(Check_Controlling_Type): A formal of a tagged incomplete type is a
	controlling argument.

	* exp_util.ads, exp_util.adb (Type_May_Have_Bit_Aligned_Components): Use
	First/Next_Component_Or_Discriminant
	(Insert_Actions): Add entries for new N_Push and N_Pop nodes
	(Find_Implemented_Interface): Removed. All the calls to this subprogram
	specify Any_Limited_Interface, and this functionality is already
	provided by the function Has_Abstract_Interfaces.
	(Find_Interface, Find_Interface_Tag, Find_Interface_ADT): Modified to
	support concurrent types implementing interfaces.
	(Find_Implemented_Interface): Removed. All the calls to this subprogram
	specify kind Any_Limited_Interface, and this functionality is already
	provided by the function Has_Abstract_Interfaces.
	(Remove_Side_Effects): replace Controlled_Type by
	CW_Or_Controlled_Type whenever the issue is related to
	using or not the secondary stack.

	* par-ch12.adb (P_Formal_Type_Definition): Update calls to
	P_Interface_Type_Definition to fulfill the new interface (the formal
	Is_Synchronized is no longer required).

	* Make-lang.in (GNAT_ADA_OBJS): Addition of exp_atag.o
	Update dependencies.

	* exp_atag.ads, exp_atag.adb: New file



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

1 files changed, 19 insertions, 9 deletions

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 9ccbff7c718..5d81004dace 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -204,6 +204,12 @@ package body Sem_Disp is
                Tagged_Type := Base_Type (Designated_Type (T));
             end if;
 
+         --  Ada 2005 : an incomplete type can be tagged. An operation with
+         --  an access parameter of the type is dispatching.
+
+         elsif Scope (Designated_Type (T)) = Current_Scope then
+            Tagged_Type := Designated_Type (T);
+
          --  Ada 2005 (AI-50217)
 
          elsif From_With_Type (Designated_Type (T))
@@ -231,13 +237,13 @@ package body Sem_Disp is
                and then (not Is_Generic_Type (Tagged_Type)
                           or else not Comes_From_Source (Subp)))
         or else
-          (Is_Formal_Subprogram (Subp) and then Is_Abstract (Subp))
+          (Is_Formal_Subprogram (Subp) and then Is_Abstract_Subprogram (Subp))
         or else
           (Nkind (Parent (Parent (Subp))) = N_Subprogram_Renaming_Declaration
             and then
               Present (Corresponding_Formal_Spec (Parent (Parent (Subp))))
             and then
-              Is_Abstract (Subp))
+              Is_Abstract_Subprogram (Subp))
       then
          return Tagged_Type;
 
@@ -274,11 +280,11 @@ package body Sem_Disp is
          Par  : Node_Id;
 
       begin
-         if Is_Abstract (Subp)
+         if Is_Abstract_Subprogram (Subp)
            and then No (Controlling_Argument (N))
          then
             if Present (Alias (Subp))
-              and then not Is_Abstract (Alias (Subp))
+              and then not Is_Abstract_Subprogram (Alias (Subp))
               and then No (DTC_Entity (Subp))
             then
                --  Private overriding of inherited abstract operation,
@@ -428,6 +434,7 @@ package body Sem_Disp is
             --  Mark call as a dispatching call
 
             Set_Controlling_Argument (N, Control);
+            Check_Restriction (No_Dispatching_Calls, N);
 
             --  Ada 2005 (AI-318-02): Check current implementation restriction
             --  that a dispatching call cannot be made to a primitive function
@@ -481,7 +488,7 @@ package body Sem_Disp is
                            (Expression (Original_Node (Actual)))));
                   end if;
 
-                  if Present (Func) and then Is_Abstract (Func) then
+                  if Present (Func) and then Is_Abstract_Subprogram (Func) then
                      Error_Msg_N (
                        "call to abstract function must be dispatching", N);
                   end if;
@@ -1080,7 +1087,8 @@ package body Sem_Disp is
                --  a descendant type and inherits a nonabstract version.
 
                if Etype (Subp) /= Tagged_Type then
-                  Set_Is_Abstract (Old_Subp, Is_Abstract (Alias (Subp)));
+                  Set_Is_Abstract_Subprogram
+                    (Old_Subp, Is_Abstract_Subprogram (Alias (Subp)));
                end if;
             end if;
          end if;
@@ -1315,7 +1323,8 @@ package body Sem_Disp is
       then
          --  Ada 2005 (AI-251): Update the attribute alias of all the aliased
          --  entities of the overriden primitive to reference New_Op, and also
-         --  propagate them the new value of the attribute Is_Abstract.
+         --  propagate them the new value of the attribute
+         --  Is_Abstract_Subprogram.
 
          Elmt := First_Elmt (Primitive_Operations (Tagged_Type));
          while Present (Elmt) loop
@@ -1328,12 +1337,13 @@ package body Sem_Disp is
               and then Alias (Prim) = Prev_Op
             then
                Set_Alias (Prim, New_Op);
-               Set_Is_Abstract (Prim, Is_Abstract (New_Op));
+               Set_Is_Abstract_Subprogram
+                 (Prim, Is_Abstract_Subprogram (New_Op));
 
                --  Ensure that this entity will be expanded to fill the
                --  corresponding entry in its dispatch table.
 
-               if not Is_Abstract (Prim) then
+               if not Is_Abstract_Subprogram (Prim) then
                   Set_Has_Delayed_Freeze (Prim);
                end if;
             end if;