From 343d35dc66bb93bde59e03709f7cb27e3d9c7d8f Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 6 Apr 2007 09:20:11 +0000 Subject: 2007-04-06 Javier Miranda Gary Dismukes Ed Schonberg * 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 --- gcc/ada/sem_disp.adb | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) (limited to 'gcc/ada/sem_disp.adb') 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; -- cgit v1.2.1