From f715a5bd3fb6bb70c11b29dc2b54f2459ed36bfb Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 16 Mar 2020 19:28:47 +0100 Subject: [Ada] Consolidate handling of implicit dereferences into semantic analysis 2020-06-11 Eric Botcazou gcc/ada/ * checks.adb (Build_Discriminant_Checks): Build an explicit dereference when the type is an access type. * exp_atag.adb (Build_CW_Membership): Add explicit dereferences. (Build_Get_Access_Level): Likewise. (Build_Get_Alignment): Likewise. (Build_Inherit_Prims): Likewise. (Build_Get_Transportable): Likewise. (Build_Set_Size_Function): Likewise. * exp_ch3.adb (Build_Offset_To_Top_Function): Likewise. * exp_ch4.adb (Expand_Allocator_Expression): Likewise. (Expand_N_Indexed_Component ): Remove code dealing with implicit dereferences. (Expand_N_Selected_Component): Likewise. (Expand_N_Slice): Likewise. * exp_ch9.adb (Add_Formal_Renamings): Add explicit dereference. (Expand_Accept_Declarations): Likewise. (Build_Simple_Entry_Call): Remove code dealing with implicit dereferences. (Expand_N_Requeue_Statement): Likewise. * exp_disp.adb (Expand_Dispatching_Call): Build an explicit dereference when the controlling type is an access type. * exp_spark.adb (Expand_SPARK_N_Selected_Component): Delete. (Expand_SPARK_N_Slice_Or_Indexed_Component): Likewise. (Expand_SPARK): Do not call them. * sem_ch4.adb (Process_Implicit_Dereference_Prefix): Delete. (Process_Indexed_Component): Call Implicitly_Designated_Type to get the designated type for an implicit dereference. (Analyze_Overloaded_Selected_Component): Do not insert an explicit dereference here. (Analyze_Selected_Component): Likewise. (Analyze_Slice): Call Implicitly_Designated_Type to get the designated type for an implicit dereference. * sem_ch8.adb (Has_Components): New predicate extracted from... (Is_Appropriate_For_Record): ...this. Delete. (Is_Appropriate_For_Entry_Prefix): Likewise. (Analyze_Renamed_Entry): Deal with implicit dereferences. (Find_Selected_Component): Do not insert an explicit dereference here. Call Implicitly_Designated_Type to get the designated type for an implicit dereference. Call Has_Components, Is_Task_Type and Is_Protected_Type directly. Adjust test for error. * sem_res.adb (Resolve_Implicit_Dereference): New procedure. (Resolve_Call): Call Resolve_Indexed_Component last. (Resolve_Entry): Call Resolve_Implicit_Dereference on the prefix. (Resolve_Indexed_Component): Call Implicitly_Designated_Type to get the designated type for an implicit dereference and Resolve_Implicit_Dereference on the prefix at the end. (Resolve_Selected_Component): Likewise. (Resolve_Slice): Likewise. Do not apply access checks here. * sem_util.ads (Implicitly_Designated_Type): Declare. * sem_util.adb (Copy_And_Maybe_Dereference): Simplify. (Implicitly_Designated_Type): New function. (Object_Access_Level): Fix typo. * sem_warn.adb (Check_Unset_Reference): Test Comes_From_Source on the original node. --- gcc/ada/sem_ch4.adb | 111 +++++----------------------------------------------- 1 file changed, 10 insertions(+), 101 deletions(-) (limited to 'gcc/ada/sem_ch4.adb') diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 3d3e2c7..a710ba2 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -171,6 +171,7 @@ package body Sem_Ch4 is -- being called. The caller will have verified that the object is legal -- for the call. If the remaining parameters match, the first parameter -- will rewritten as a dereference if needed, prior to completing analysis. + procedure Check_Misspelled_Selector (Prefix : Entity_Id; Sel : Node_Id); @@ -276,20 +277,6 @@ package body Sem_Ch4 is -- type is not directly visible. The routine uses this type to emit a more -- informative message. - function Process_Implicit_Dereference_Prefix - (E : Entity_Id; - P : Node_Id) return Entity_Id; - -- Called when P is the prefix of an implicit dereference, denoting an - -- object E. The function returns the designated type of the prefix, taking - -- into account that the designated type of an anonymous access type may be - -- a limited view, when the nonlimited view is visible. - -- - -- If in semantics only mode (-gnatc or generic), the function also records - -- that the prefix is a reference to E, if any. Normally, such a reference - -- is generated only when the implicit dereference is expanded into an - -- explicit one, but for consistency we must generate the reference when - -- expansion is disabled as well. - procedure Remove_Abstract_Operations (N : Node_Id); -- Ada 2005: implementation of AI-310. An abstract non-dispatching -- operation is not a candidate interpretation. @@ -2351,7 +2338,10 @@ package body Sem_Ch4 is procedure Process_Function_Call; -- Prefix in indexed component form is an overloadable entity, so the - -- node is a function call. Reformat it as such. + -- node is very likely a function call; reformat it as such. The only + -- exception is a call to a parameterless function that returns an + -- array type, or an access type thereof, in which case this will be + -- undone later by Resolve_Call or Resolve_Entry_Call. procedure Process_Indexed_Component; -- Prefix in indexed component form is actually an indexed component. @@ -2462,7 +2452,7 @@ package body Sem_Ch4 is if Is_Access_Type (Array_Type) then Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); - Array_Type := Process_Implicit_Dereference_Prefix (Pent, P); + Array_Type := Implicitly_Designated_Type (Array_Type); end if; if Is_Array_Type (Array_Type) then @@ -3898,18 +3888,6 @@ package body Sem_Ch4 is Set_Etype (Sel, Etype (Comp)); Set_Etype (N, Etype (Comp)); Set_Etype (Nam, It.Typ); - - -- For access type case, introduce explicit dereference for - -- more uniform treatment of entry calls. Do this only once - -- if several interpretations yield an access type. - - if Is_Access_Type (Etype (Nam)) - and then Nkind (Nam) /= N_Explicit_Dereference - then - Insert_Explicit_Dereference (Nam); - Error_Msg_NW - (Warn_On_Dereference, "?d?implicit dereference", N); - end if; end if; Next_Entity (Comp); @@ -4379,7 +4357,6 @@ package body Sem_Ch4 is In_Scope : Boolean; Is_Private_Op : Boolean; Parent_N : Node_Id; - Pent : Entity_Id := Empty; Prefix_Type : Entity_Id; Type_To_Use : Entity_Id; @@ -4408,7 +4385,8 @@ package body Sem_Ch4 is -- indexed component rather than a function call. function Has_Dereference (Nod : Node_Id) return Boolean; - -- Check whether prefix includes a dereference at any level. + -- Check whether prefix includes a dereference, explicit or implicit, + -- at any recursive level. -------------------------------- -- Find_Component_In_Instance -- @@ -4520,10 +4498,6 @@ package body Sem_Ch4 is if Nkind (Nod) = N_Explicit_Dereference then return True; - -- When expansion is disabled an explicit dereference may not have - -- been inserted, but if this is an access type the indirection makes - -- the call safe. - elsif Is_Access_Type (Etype (Nod)) then return True; @@ -4576,16 +4550,7 @@ package body Sem_Ch4 is else Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); - - if Is_Entity_Name (Name) then - Pent := Entity (Name); - elsif Nkind (Name) = N_Selected_Component - and then Is_Entity_Name (Selector_Name (Name)) - then - Pent := Entity (Selector_Name (Name)); - end if; - - Prefix_Type := Process_Implicit_Dereference_Prefix (Pent, Name); + Prefix_Type := Implicitly_Designated_Type (Prefix_Type); end if; -- If we have an explicit dereference of a remote access-to-class-wide @@ -4673,11 +4638,6 @@ package body Sem_Ch4 is Set_Etype (N, Etype (Comp)); Check_Implicit_Dereference (N, Etype (Comp)); - if Is_Access_Type (Etype (Name)) then - Insert_Explicit_Dereference (Name); - Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); - end if; - elsif Is_Record_Type (Prefix_Type) then -- Find component with given name. In an instance, if the node is @@ -4978,15 +4938,6 @@ package body Sem_Ch4 is if Ekind (Comp) = E_Discriminant then Set_Original_Discriminant (Sel, Comp); end if; - - -- For access type case, introduce explicit dereference for - -- more uniform treatment of entry calls. - - if Is_Access_Type (Etype (Name)) then - Insert_Explicit_Dereference (Name); - Error_Msg_NW - (Warn_On_Dereference, "?d?implicit dereference", N); - end if; end if; <> @@ -5455,8 +5406,8 @@ package body Sem_Ch4 is Set_Etype (N, Any_Type); if Is_Access_Type (Array_Type) then - Array_Type := Designated_Type (Array_Type); Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N); + Array_Type := Implicitly_Designated_Type (Array_Type); end if; if not Is_Array_Type (Array_Type) then @@ -7401,48 +7352,6 @@ package body Sem_Ch4 is end if; end Operator_Check; - ----------------------------------------- - -- Process_Implicit_Dereference_Prefix -- - ----------------------------------------- - - function Process_Implicit_Dereference_Prefix - (E : Entity_Id; - P : Entity_Id) return Entity_Id - is - Ref : Node_Id; - Typ : constant Entity_Id := Designated_Type (Etype (P)); - - begin - if Present (E) - and then (Operating_Mode = Check_Semantics or else not Expander_Active) - then - -- We create a dummy reference to E to ensure that the reference is - -- not considered as part of an assignment (an implicit dereference - -- can never assign to its prefix). The Comes_From_Source attribute - -- needs to be propagated for accurate warnings. - - Ref := New_Occurrence_Of (E, Sloc (P)); - Set_Comes_From_Source (Ref, Comes_From_Source (P)); - Generate_Reference (E, Ref); - end if; - - -- An implicit dereference is a legal occurrence of an incomplete type - -- imported through a limited_with clause, if the full view is visible. - - if From_Limited_With (Typ) - and then not From_Limited_With (Scope (Typ)) - and then - (Is_Immediately_Visible (Scope (Typ)) - or else - (Is_Child_Unit (Scope (Typ)) - and then Is_Visible_Lib_Unit (Scope (Typ)))) - then - return Available_View (Typ); - else - return Typ; - end if; - end Process_Implicit_Dereference_Prefix; - -------------------------------- -- Remove_Abstract_Operations -- -------------------------------- -- cgit v1.1