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,
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)))),
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)),
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));
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;
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)),
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)),
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));
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)),
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))))));
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))
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
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);
-- 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)
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;
-- 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
-- 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.
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 :=
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)
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));
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.
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,
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 --
------------------
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 =>
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;
-- 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);
-- 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.
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.
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
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);
In_Scope : Boolean;
Is_Private_Op : Boolean;
Parent_N : Node_Id;
- Pent : Entity_Id := Empty;
Prefix_Type : Entity_Id;
Type_To_Use : Entity_Id;
-- 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 --
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;
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
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
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>>
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
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 --
--------------------------------
-- 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
-- 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;
-- 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;
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
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
-- 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)))
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);
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 "
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 --
------------------------------------
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 --
----------------------
-- 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
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));
-- the ABE Processing phase.
Build_Call_Marker (Prefix (N));
+
+ Resolve_Indexed_Component (N, Typ);
end if;
end if;
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));
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 --
-------------------------------
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
end loop;
end if;
+ Resolve_Implicit_Dereference (Prefix (N));
Analyze_Dimension (N);
-- Do not generate the warning on suspicious index if we are analyzing
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
Prefix (N));
end if;
+ Resolve_Implicit_Dereference (Prefix (N));
Analyze_Dimension (N);
end Resolve_Selected_Component;
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
Warn_On_Suspicious_Index (Name, High_Bound (Drange));
end if;
+ Resolve_Implicit_Dereference (Prefix (N));
Analyze_Dimension (N);
Eval_Slice (N);
end Resolve_Slice;
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
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 --
------------------------------------
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;
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.
-- 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;
projects / gcc.git / commitdiff