OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Consolidate handling of implicit dereferences into semantic analysis

Browse Source 
2020-06-11  Eric Botcazou  <ebotcazou@adacore.com>

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.
This commit is contained in:
Eric Botcazou 2020-03-16 19:28:47 +01:00 committed by Pierre-Marie de Rodat
parent c7cb99f885
commit f715a5bd3f
13 changed files with 174 additions and 366 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/ada/checks.adb
View File

@ -3964,6 +3964,15 @@ package body Checks is
Duplicate_Subexpr_No_Checks
(Aggregate_Discriminant_Val (Disc_Ent));
elsif Is_Access_Type (Etype (N)) then
Dref :=
Make_Selected_Component (Loc,
Prefix =>
Make_Explicit_Dereference (Loc,
Duplicate_Subexpr_No_Checks (N, Name_Req => True)),
Selector_Name => Make_Identifier (Loc, Chars (Disc_Ent)));
Set_Is_In_Discriminant_Check (Dref);
else
Dref :=
Make_Selected_Component (Loc,

39
gcc/ada/exp_atag.adb
View File

@ -229,14 +229,18 @@ package body Exp_Atag is
Make_Op_Subtract (Loc,
Left_Opnd =>
Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (Obj_TSD, Loc),
Prefix =>
Make_Explicit_Dereference (Loc,
New_Occurrence_Of (Obj_TSD, Loc)),
Selector_Name =>
New_Occurrence_Of
(RTE_Record_Component (RE_Idepth), Loc)),
Right_Opnd =>
Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (Typ_TSD, Loc),
Prefix =>
Make_Explicit_Dereference (Loc,
New_Occurrence_Of (Typ_TSD, Loc)),
Selector_Name =>
New_Occurrence_Of
(RTE_Record_Component (RE_Idepth), Loc)))),
@ -255,7 +259,9 @@ package body Exp_Atag is
Make_Indexed_Component (Loc,
Prefix =>
Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (Obj_TSD, Loc),
Prefix =>
Make_Explicit_Dereference (Loc,
New_Occurrence_Of (Obj_TSD, Loc)),
Selector_Name =>
New_Occurrence_Of
(RTE_Record_Component (RE_Tags_Table), Loc)),
@ -293,8 +299,9 @@ package body Exp_Atag is
return
Make_Selected_Component (Loc,
Prefix =>
Build_TSD (Loc,
Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
Make_Explicit_Dereference (Loc,
Build_TSD (Loc,
Unchecked_Convert_To (RTE (RE_Address), Tag_Node))),
Selector_Name =>
New_Occurrence_Of
(RTE_Record_Component (RE_Access_Level), Loc));
@ -311,8 +318,10 @@ package body Exp_Atag is
begin
return
Make_Selected_Component (Loc,
Prefix =>
Build_TSD (Loc, Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
Prefix =>
Make_Explicit_Dereference (Loc,
Build_TSD (Loc,
Unchecked_Convert_To (RTE (RE_Address), Tag_Node))),
Selector_Name =>
New_Occurrence_Of (RTE_Record_Component (RE_Alignment), Loc));
end Build_Get_Alignment;
@ -639,7 +648,8 @@ package body Exp_Atag is
Prefix =>
Make_Selected_Component (Loc,
Prefix =>
Build_DT (Loc, New_Tag_Node),
Make_Explicit_Dereference (Loc,
Build_DT (Loc, New_Tag_Node)),
Selector_Name =>
New_Occurrence_Of
(RTE_Record_Component (RE_Prims_Ptr), Loc)),
@ -651,7 +661,8 @@ package body Exp_Atag is
Prefix =>
Make_Selected_Component (Loc,
Prefix =>
Build_DT (Loc, Old_Tag_Node),
Make_Explicit_Dereference (Loc,
Build_DT (Loc, Old_Tag_Node)),
Selector_Name =>
New_Occurrence_Of
(RTE_Record_Component (RE_Prims_Ptr), Loc)),
@ -728,8 +739,9 @@ package body Exp_Atag is
return
Make_Selected_Component (Loc,
Prefix =>
Build_TSD (Loc,
Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
Make_Explicit_Dereference (Loc,
Build_TSD (Loc,
Unchecked_Convert_To (RTE (RE_Address), Tag_Node))),
Selector_Name =>
New_Occurrence_Of
(RTE_Record_Component (RE_Transportable), Loc));
@ -884,8 +896,9 @@ package body Exp_Atag is
Name =>
Make_Selected_Component (Loc,
Prefix =>
Build_TSD (Loc,
Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
Make_Explicit_Dereference (Loc,
Build_TSD (Loc,
Unchecked_Convert_To (RTE (RE_Address), Tag_Node))),
Selector_Name =>
New_Occurrence_Of
(RTE_Record_Component (RE_Size_Func), Loc)),

5
gcc/ada/exp_ch3.adb
View File

@ -2257,8 +2257,9 @@ package body Exp_Ch3 is
Prefix =>
Make_Selected_Component (Loc,
Prefix =>
Unchecked_Convert_To (Acc_Type,
Make_Identifier (Loc, Name_uO)),
Make_Explicit_Dereference (Loc,
Unchecked_Convert_To (Acc_Type,
Make_Identifier (Loc, Name_uO))),
Selector_Name =>
New_Occurrence_Of (Iface_Comp, Loc)),
Attribute_Name => Name_Position))))));

53
gcc/ada/exp_ch4.adb
View File

@ -1073,7 +1073,9 @@ package body Exp_Ch4 is
elsif Is_Tagged_Type (T) and then not Is_Class_Wide_Type (T) then
TagT := T;
TagR := New_Occurrence_Of (Temp, Loc);
TagR :=
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Temp, Loc));
elsif Is_Private_Type (T)
and then Is_Tagged_Type (Underlying_Type (T))
@ -6868,7 +6870,6 @@ package body Exp_Ch4 is
Typ : constant Entity_Id := Etype (N);
P : constant Node_Id := Prefix (N);
T : constant Entity_Id := Etype (P);
Atp : Entity_Id;
begin
-- A special optimization, if we have an indexed component that is
@ -6917,20 +6918,6 @@ package body Exp_Ch4 is
Make_Build_In_Place_Iface_Call_In_Anonymous_Context (P);
end if;
-- If the prefix is an access type, then we unconditionally rewrite if
-- as an explicit dereference. This simplifies processing for several
-- cases, including packed array cases and certain cases in which checks
-- must be generated. We used to try to do this only when it was
-- necessary, but it cleans up the code to do it all the time.
if Is_Access_Type (T) then
Insert_Explicit_Dereference (P);
Analyze_And_Resolve (P, Designated_Type (T));
Atp := Designated_Type (T);
else
Atp := T;
end if;
-- Generate index and validity checks
Generate_Index_Checks (N);
@ -6942,8 +6929,8 @@ package body Exp_Ch4 is
-- If selecting from an array with atomic components, and atomic sync
-- is not suppressed for this array type, set atomic sync flag.
if (Has_Atomic_Components (Atp)
and then not Atomic_Synchronization_Disabled (Atp))
if (Has_Atomic_Components (T)
and then not Atomic_Synchronization_Disabled (T))
or else (Is_Atomic (Typ)
and then not Atomic_Synchronization_Disabled (Typ))
or else (Is_Entity_Name (P)
@ -10580,7 +10567,7 @@ package body Exp_Ch4 is
Par : constant Node_Id := Parent (N);
P : constant Node_Id := Prefix (N);
S : constant Node_Id := Selector_Name (N);
Ptyp : Entity_Id := Underlying_Type (Etype (P));
Ptyp : constant Entity_Id := Underlying_Type (Etype (P));
Disc : Entity_Id;
New_N : Node_Id;
Dcon : Elmt_Id;
@ -10631,21 +10618,6 @@ package body Exp_Ch4 is
-- Start of processing for Expand_N_Selected_Component
begin
-- Insert explicit dereference if required
if Is_Access_Type (Ptyp) then
-- First set prefix type to proper access type, in case it currently
-- has a private (non-access) view of this type.
Set_Etype (P, Ptyp);
Insert_Explicit_Dereference (P);
Analyze_And_Resolve (P, Designated_Type (Ptyp));
Ptyp := Etype (P);
end if;
-- Deal with discriminant check required
if Do_Discriminant_Check (N) then
@ -11018,23 +10990,10 @@ package body Exp_Ch4 is
-- Local variables
Pref : constant Node_Id := Prefix (N);
Pref_Typ : Entity_Id := Etype (Pref);
-- Start of processing for Expand_N_Slice
begin
-- Special handling for access types
if Is_Access_Type (Pref_Typ) then
Pref_Typ := Designated_Type (Pref_Typ);
Rewrite (Pref,
Make_Explicit_Dereference (Sloc (N),
Prefix => Relocate_Node (Pref)));
Analyze_And_Resolve (Pref, Pref_Typ);
end if;
-- Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
-- function, then additional actuals must be passed.

28
gcc/ada/exp_ch9.adb
View File

@ -737,8 +737,9 @@ package body Exp_Ch9 is
Renamed_Formal :=
Make_Selected_Component (Loc,
Prefix =>
Unchecked_Convert_To (Entry_Parameters_Type (Ent),
Make_Identifier (Loc, Chars (Ptr))),
Make_Explicit_Dereference (Loc,
Unchecked_Convert_To (Entry_Parameters_Type (Ent),
Make_Identifier (Loc, Chars (Ptr)))),
Selector_Name => New_Occurrence_Of (Comp, Loc));
Decl :=
@ -4523,12 +4524,6 @@ package body Exp_Ch9 is
Ent_Acc := Entry_Parameters_Type (Ent);
Conctyp := Etype (Concval);
-- If prefix is an access type, dereference to obtain the task type
if Is_Access_Type (Conctyp) then
Conctyp := Designated_Type (Conctyp);
end if;
-- Special case for protected subprogram calls
if Is_Protected_Type (Conctyp)
@ -6015,9 +6010,10 @@ package body Exp_Ch9 is
Renamed_Formal :=
Make_Selected_Component (Loc,
Prefix =>
Unchecked_Convert_To (
Entry_Parameters_Type (Ent),
New_Occurrence_Of (Ann, Loc)),
Make_Explicit_Dereference (Loc,
Unchecked_Convert_To (
Entry_Parameters_Type (Ent),
New_Occurrence_Of (Ann, Loc))),
Selector_Name =>
New_Occurrence_Of (Comp, Loc));
@ -10533,16 +10529,6 @@ package body Exp_Ch9 is
Extract_Entry (N, Concval, Ename, Index);
Conc_Typ := Etype (Concval);
-- If the prefix is an access to class-wide type, dereference to get
-- object and entry type.
if Is_Access_Type (Conc_Typ) then
Conc_Typ := Designated_Type (Conc_Typ);
Rewrite (Concval,
Make_Explicit_Dereference (Loc, Relocate_Node (Concval)));
Analyze_And_Resolve (Concval, Conc_Typ);
end if;
-- Examine the scope stack in order to find nearest enclosing protected
-- or task type. This will constitute our invocation source.

8
gcc/ada/exp_disp.adb
View File

@ -1114,6 +1114,14 @@ package body Exp_Disp is
then
Controlling_Tag := Duplicate_Subexpr (Ctrl_Arg);
elsif Is_Access_Type (Ctrl_Typ) then
Controlling_Tag :=
Make_Selected_Component (Loc,
Prefix =>
Make_Explicit_Dereference (Loc,
Duplicate_Subexpr_Move_Checks (Ctrl_Arg)),
Selector_Name => New_Occurrence_Of (DTC_Entity (Subp), Loc));
else
Controlling_Tag :=
Make_Selected_Component (Loc,

50
gcc/ada/exp_spark.adb
View File

@ -69,12 +69,6 @@ package body Exp_SPARK is
procedure Expand_SPARK_N_Op_Ne (N : Node_Id);
-- Rewrite operator /= based on operator = when defined explicitly
procedure Expand_SPARK_N_Selected_Component (N : Node_Id);
-- Insert explicit dereference if required
procedure Expand_SPARK_N_Slice_Or_Indexed_Component (N : Node_Id);
-- Insert explicit dereference if required
------------------
-- Expand_SPARK --
------------------
@ -136,14 +130,6 @@ package body Exp_SPARK is
Expand_SPARK_N_Freeze_Type (Entity (N));
end if;
when N_Indexed_Component
| N_Slice
=>
Expand_SPARK_N_Slice_Or_Indexed_Component (N);
when N_Selected_Component =>
Expand_SPARK_N_Selected_Component (N);
-- In SPARK mode, no other constructs require expansion
when others =>
@ -481,40 +467,4 @@ package body Exp_SPARK is
end if;
end Expand_SPARK_Potential_Renaming;
---------------------------------------
-- Expand_SPARK_N_Selected_Component --
---------------------------------------
procedure Expand_SPARK_N_Selected_Component (N : Node_Id) is
Pref : constant Node_Id := Prefix (N);
Typ : constant Entity_Id := Underlying_Type (Etype (Pref));
begin
if Present (Typ) and then Is_Access_Type (Typ) then
-- First set prefix type to proper access type, in case it currently
-- has a private (non-access) view of this type.
Set_Etype (Pref, Typ);
Insert_Explicit_Dereference (Pref);
Analyze_And_Resolve (Pref, Designated_Type (Typ));
end if;
end Expand_SPARK_N_Selected_Component;
-----------------------------------------------
-- Expand_SPARK_N_Slice_Or_Indexed_Component --
-----------------------------------------------
procedure Expand_SPARK_N_Slice_Or_Indexed_Component (N : Node_Id) is
Pref : constant Node_Id := Prefix (N);
Typ : constant Entity_Id := Etype (Pref);
begin
if Is_Access_Type (Typ) then
Insert_Explicit_Dereference (Pref);
Analyze_And_Resolve (Pref, Designated_Type (Typ));
end if;
end Expand_SPARK_N_Slice_Or_Indexed_Component;
end Exp_SPARK;

111
gcc/ada/sem_ch4.adb
View File

@ -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;
<<Next_Comp>>
@ -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 --
--------------------------------

140
gcc/ada/sem_ch8.adb
View File

@ -501,6 +501,10 @@ package body Sem_Ch8 is
-- Ada 2005 (AI-262): Determines if the current compilation unit has a
-- private with on E.
function Has_Components (Typ : Entity_Id) return Boolean;
-- Determine if given type has components, i.e. is either a record type or
-- type or a type that has discriminants.
function Has_Implicit_Operator (N : Node_Id) return Boolean;
-- N is an expanded name whose selector is an operator name (e.g. P."+").
-- declarative part contains an implicit declaration of an operator if it
@ -515,14 +519,6 @@ package body Sem_Ch8 is
-- specification are discarded and replaced with those of the renamed
-- subprogram, which are then used to recheck the default values.
function Is_Appropriate_For_Entry_Prefix (T : Entity_Id) return Boolean;
-- True if it is of a task type, a protected type, or else an access to one
-- of these types.
function Is_Appropriate_For_Record (T : Entity_Id) return Boolean;
-- Prefix is appropriate for record if it is of a record type, or an access
-- to such.
function Most_Descendant_Use_Clause
(Clause1 : Entity_Id;
Clause2 : Entity_Id) return Entity_Id;
@ -1736,6 +1732,9 @@ package body Sem_Ch8 is
-- The prefix can be an arbitrary expression that yields a task or
-- protected object, so it must be resolved.
if Is_Access_Type (Etype (Prefix (Nam))) then
Insert_Explicit_Dereference (Prefix (Nam));
end if;
Resolve (Prefix (Nam), Scope (Old_S));
end if;
@ -7333,23 +7332,6 @@ package body Sem_Ch8 is
Set_Etype (N, C_Etype);
end;
-- If this is the name of an entry or protected operation, and
-- the prefix is an access type, insert an explicit dereference,
-- so that entry calls are treated uniformly.
if Is_Access_Type (Etype (P))
and then Is_Concurrent_Type (Designated_Type (Etype (P)))
then
declare
New_P : constant Node_Id :=
Make_Explicit_Dereference (Sloc (P),
Prefix => Relocate_Node (P));
begin
Rewrite (P, New_P);
Set_Etype (P, Designated_Type (Etype (Prefix (P))));
end;
end if;
-- If the selected component appears within a default expression
-- and it has an actual subtype, the preanalysis has not yet
-- completed its analysis, because Insert_Actions is disabled in
@ -7393,37 +7375,16 @@ package body Sem_Ch8 is
Write_Entity_Info (P_Type, " "); Write_Eol;
end if;
-- The designated type may be a limited view with no components.
-- Check whether the non-limited view is available, because in some
-- cases this will not be set when installing the context. Rewrite
-- the node by introducing an explicit dereference at once, and
-- setting the type of the rewritten prefix to the non-limited view
-- of the original designated type.
-- If the prefix's type is an access type, get to the record type
if Is_Access_Type (P_Type) then
declare
Desig_Typ : constant Entity_Id :=
Directly_Designated_Type (P_Type);
begin
if Is_Incomplete_Type (Desig_Typ)
and then From_Limited_With (Desig_Typ)
and then Present (Non_Limited_View (Desig_Typ))
then
Rewrite (P,
Make_Explicit_Dereference (Sloc (P),
Prefix => Relocate_Node (P)));
Set_Etype (P, Get_Full_View (Non_Limited_View (Desig_Typ)));
P_Type := Etype (P);
end if;
end;
P_Type := Implicitly_Designated_Type (P_Type);
end if;
-- First check for components of a record object (not the
-- result of a call, which is handled below).
if Is_Appropriate_For_Record (P_Type)
if Has_Components (P_Type)
and then not Is_Overloadable (P_Name)
and then not Is_Type (P_Name)
then
@ -7437,7 +7398,7 @@ package body Sem_Ch8 is
-- Reference to type name in predicate/invariant expression
elsif Is_Appropriate_For_Entry_Prefix (P_Type)
elsif (Is_Task_Type (P_Type) or else Is_Protected_Type (P_Type))
and then not In_Open_Scopes (P_Name)
and then (not Is_Concurrent_Type (Etype (P_Name))
or else not In_Open_Scopes (Etype (P_Name)))
@ -7616,16 +7577,6 @@ package body Sem_Ch8 is
else
-- Format node as expanded name, to avoid cascaded errors
-- If the limited_with transformation was applied earlier, restore
-- source for proper error reporting.
if not Comes_From_Source (P)
and then Nkind (P) = N_Explicit_Dereference
then
Rewrite (P, Prefix (P));
P_Type := Etype (P);
end if;
Change_Selected_Component_To_Expanded_Name (N);
Set_Entity (N, Any_Id);
Set_Etype (N, Any_Type);
@ -7687,8 +7638,8 @@ package body Sem_Ch8 is
Error_Msg_N ("invalid prefix in selected component&", P);
if Is_Access_Type (P_Type)
and then Ekind (Designated_Type (P_Type)) = E_Incomplete_Type
if Is_Incomplete_Type (P_Type)
and then Is_Access_Type (Etype (P))
then
Error_Msg_N
("\dereference must not be of an incomplete type "
@ -8042,6 +7993,20 @@ package body Sem_Ch8 is
end if;
end Find_Type;
--------------------
-- Has_Components --
--------------------
function Has_Components (Typ : Entity_Id) return Boolean is
begin
return Is_Record_Type (Typ)
or else (Is_Private_Type (Typ) and then Has_Discriminants (Typ))
or else (Is_Task_Type (Typ) and then Has_Discriminants (Typ))
or else (Is_Incomplete_Type (Typ)
and then From_Limited_With (Typ)
and then Is_Record_Type (Available_View (Typ)));
end Has_Components;
------------------------------------
-- Has_Implicit_Character_Literal --
------------------------------------
@ -8485,57 +8450,6 @@ package body Sem_Ch8 is
end loop;
end Install_Use_Clauses;
-------------------------------------
-- Is_Appropriate_For_Entry_Prefix --
-------------------------------------
function Is_Appropriate_For_Entry_Prefix (T : Entity_Id) return Boolean is
P_Type : Entity_Id := T;
begin
if Is_Access_Type (P_Type) then
P_Type := Designated_Type (P_Type);
end if;
return Is_Task_Type (P_Type) or else Is_Protected_Type (P_Type);
end Is_Appropriate_For_Entry_Prefix;
-------------------------------
-- Is_Appropriate_For_Record --
-------------------------------
function Is_Appropriate_For_Record (T : Entity_Id) return Boolean is
function Has_Components (T1 : Entity_Id) return Boolean;
-- Determine if given type has components (i.e. is either a record
-- type or a type that has discriminants).
--------------------
-- Has_Components --
--------------------
function Has_Components (T1 : Entity_Id) return Boolean is
begin
return Is_Record_Type (T1)
or else (Is_Private_Type (T1) and then Has_Discriminants (T1))
or else (Is_Task_Type (T1) and then Has_Discriminants (T1))
or else (Is_Incomplete_Type (T1)
and then From_Limited_With (T1)
and then Present (Non_Limited_View (T1))
and then Is_Record_Type
(Get_Full_View (Non_Limited_View (T1))));
end Has_Components;
-- Start of processing for Is_Appropriate_For_Record
begin
return
Present (T)
and then (Has_Components (T)
or else (Is_Access_Type (T)
and then Has_Components (Designated_Type (T))));
end Is_Appropriate_For_Record;
----------------------
-- Mark_Use_Clauses --
----------------------

52
gcc/ada/sem_res.adb
View File

@ -226,6 +226,12 @@ package body Sem_Res is
-- is the context type, which is used when the operation is a protected
-- function with no arguments, and the return value is indexed.
procedure Resolve_Implicit_Dereference (P : Node_Id);
-- Called when P is the prefix of an indexed component, or of a selected
-- component, or of a slice. If P is of an access type, we unconditionally
-- rewrite it as an explicit dereference. This ensures that the expander
-- and the code generator have a fully explicit tree to work with.
procedure Resolve_Intrinsic_Operator (N : Node_Id; Typ : Entity_Id);
-- A call to a user-defined intrinsic operator is rewritten as a call to
-- the corresponding predefined operator, with suitable conversions. Note
@ -6369,7 +6375,6 @@ package body Sem_Res is
Set_Etype (Prefix (N), Ret_Type);
Set_Etype (N, Typ);
Resolve_Indexed_Component (N, Typ);
if Legacy_Elaboration_Checks then
Check_Elab_Call (Prefix (N));
@ -6381,6 +6386,8 @@ package body Sem_Res is
-- the ABE Processing phase.
Build_Call_Marker (Prefix (N));
Resolve_Indexed_Component (N, Typ);
end if;
end if;
@ -7783,10 +7790,12 @@ package body Sem_Res is
if Nkind (Entry_Name) = N_Selected_Component then
Resolve (Prefix (Entry_Name));
Resolve_Implicit_Dereference (Prefix (Entry_Name));
else pragma Assert (Nkind (Entry_Name) = N_Indexed_Component);
Nam := Entity (Selector_Name (Prefix (Entry_Name)));
Resolve (Prefix (Prefix (Entry_Name)));
Resolve_Implicit_Dereference (Prefix (Prefix (Entry_Name)));
Index := First (Expressions (Entry_Name));
Resolve (Index, Entry_Index_Type (Nam));
@ -8723,6 +8732,21 @@ package body Sem_Res is
Analyze_Dimension (N);
end Resolve_If_Expression;
----------------------------------
-- Resolve_Implicit_Dereference --
----------------------------------
procedure Resolve_Implicit_Dereference (P : Node_Id) is
Desig_Typ : Entity_Id;
begin
if Is_Access_Type (Etype (P)) then
Desig_Typ := Implicitly_Designated_Type (Etype (P));
Insert_Explicit_Dereference (P);
Analyze_And_Resolve (P, Desig_Typ);
end if;
end Resolve_Implicit_Dereference;
-------------------------------
-- Resolve_Indexed_Component --
-------------------------------
@ -8795,12 +8819,12 @@ package body Sem_Res is
Resolve (Name, Array_Type);
Array_Type := Get_Actual_Subtype_If_Available (Name);
-- If prefix is access type, dereference to get real array type.
-- Note: we do not apply an access check because the expander always
-- introduces an explicit dereference, and the check will happen there.
-- If the prefix's type is an access type, get to the real array type.
-- Note: we do not apply an access check because an explicit dereference
-- will be introduced later, and the check will happen there.
if Is_Access_Type (Array_Type) then
Array_Type := Designated_Type (Array_Type);
Array_Type := Implicitly_Designated_Type (Array_Type);
end if;
-- If name was overloaded, set component type correctly now
@ -8840,6 +8864,7 @@ package body Sem_Res is
end loop;
end if;
Resolve_Implicit_Dereference (Prefix (N));
Analyze_Dimension (N);
-- Do not generate the warning on suspicious index if we are analyzing
@ -10402,12 +10427,12 @@ package body Sem_Res is
Generate_Reference (Entity (S), S, 'r');
end if;
-- If prefix is an access type, the node will be transformed into an
-- explicit dereference during expansion. The type of the node is the
-- designated type of that of the prefix.
-- If the prefix's type is an access type, get to the real record type.
-- Note: we do not apply an access check because an explicit dereference
-- will be introduced later, and the check will happen there.
if Is_Access_Type (Etype (P)) then
T := Designated_Type (Etype (P));
T := Implicitly_Designated_Type (Etype (P));
Check_Fully_Declared_Prefix (T, P);
else
@ -10482,6 +10507,7 @@ package body Sem_Res is
Prefix (N));
end if;
Resolve_Implicit_Dereference (Prefix (N));
Analyze_Dimension (N);
end Resolve_Selected_Component;
@ -10712,9 +10738,12 @@ package body Sem_Res is
Resolve (Name, Array_Type);
-- If the prefix's type is an access type, get to the real array type.
-- Note: we do not apply an access check because an explicit dereference
-- will be introduced later, and the check will happen there.
if Is_Access_Type (Array_Type) then
Apply_Access_Check (N);
Array_Type := Designated_Type (Array_Type);
Array_Type := Implicitly_Designated_Type (Array_Type);
-- If the prefix is an access to an unconstrained array, we must use
-- the actual subtype of the object to perform the index checks. The
@ -10858,6 +10887,7 @@ package body Sem_Res is
Warn_On_Suspicious_Index (Name, High_Bound (Drange));
end if;
Resolve_Implicit_Dereference (Prefix (N));
Analyze_Dimension (N);
Eval_Slice (N);
end Resolve_Slice;

38
gcc/ada/sem_util.adb
View File

@ -1354,14 +1354,12 @@ package body Sem_Util is
New_N : constant Node_Id := New_Copy_Tree (N);
begin
if Is_Access_Type (Etype (New_N)) then
-- Copy the parent to have a proper Sloc on the dereference
if Is_Access_Type (Etype (N)) then
return Make_Explicit_Dereference (Sloc (Parent (N)), New_N);
Set_Parent (New_N, Parent (N));
Insert_Explicit_Dereference (New_N);
else
return New_N;
end if;
return New_N;
end Copy_And_Maybe_Dereference;
-- Start of processing for Build_Actual_Subtype_Of_Component
@ -12515,6 +12513,32 @@ package body Sem_Util is
return False;
end Implements_Interface;
--------------------------------
-- Implicitly_Designated_Type --
--------------------------------
function Implicitly_Designated_Type (Typ : Entity_Id) return Entity_Id is
Desig : constant Entity_Id := Designated_Type (Typ);
begin
-- An implicit dereference is a legal occurrence of an incomplete type
-- imported through a limited_with clause, if the full view is visible.
if Is_Incomplete_Type (Desig)
and then From_Limited_With (Desig)
and then not From_Limited_With (Scope (Desig))
and then
(Is_Immediately_Visible (Scope (Desig))
or else
(Is_Child_Unit (Scope (Desig))
and then Is_Visible_Lib_Unit (Scope (Desig))))
then
return Available_View (Desig);
else
return Desig;
end if;
end Implicitly_Designated_Type;
------------------------------------
-- In_Assertion_Expression_Pragma --
------------------------------------
@ -23402,7 +23426,7 @@ package body Sem_Util is
Orig_Pre := Original_Node (Prefix (Orig_Obj));
if Is_Access_Type (Etype (Orig_Pre)) then
return Type_Access_Level (Etype (Prefix (Orig_Obj)));
return Type_Access_Level (Etype (Orig_Pre));
else
return Object_Access_Level (Prefix (Orig_Obj));
end if;

5
gcc/ada/sem_util.ads
View File

@ -1391,6 +1391,11 @@ package Sem_Util is
Exclude_Parents : Boolean := False) return Boolean;
-- Returns true if the Typ_Ent implements interface Iface_Ent
function Implicitly_Designated_Type (Typ : Entity_Id) return Entity_Id;
-- Called when Typ is the type of the prefix of an implicit dereference.
-- Return the designated type of Typ, taking into account that this type
-- may be a limited view, when the nonlimited view is visible.
function In_Assertion_Expression_Pragma (N : Node_Id) return Boolean;
-- Returns True if node N appears within a pragma that acts as an assertion
-- expression. See Sem_Prag for the list of qualifying pragmas.

2
gcc/ada/sem_warn.adb
View File

@ -1872,7 +1872,7 @@ package body Sem_Warn is
-- have a reference from generated code, it is bogus (e.g. calls to init
-- procs to set default discriminant values).
if not Comes_From_Source (N) then
if not Comes_From_Source (Original_Node (N)) then
return;
end if;