(L, R : Node_Id;
Op_Id : Entity_Id;
N : Node_Id);
- -- For the four varieties of concatenation.
+ -- For the four varieties of concatenation
procedure Find_Equality_Types
(L, R : Node_Id;
Op_Id : Entity_Id;
N : Node_Id);
- -- Ditto for equality operators.
+ -- Ditto for equality operators
procedure Find_Boolean_Types
(L, R : Node_Id;
Op_Id : Entity_Id;
N : Node_Id);
- -- Ditto for binary logical operations.
+ -- Ditto for binary logical operations
procedure Find_Negation_Types
(R : Node_Id;
Op_Id : Entity_Id;
N : Node_Id);
- -- Find consistent interpretation for operand of negation operator.
+ -- Find consistent interpretation for operand of negation operator
procedure Find_Non_Universal_Interpretations
(N : Node_Id;
(R : Node_Id;
Op_Id : Entity_Id;
N : Node_Id);
- -- Unary arithmetic types: plus, minus, abs.
+ -- Unary arithmetic types: plus, minus, abs
procedure Check_Arithmetic_Pair
(T1, T2 : Entity_Id;
-- for the type is not directly visible. The routine uses this type to emit
-- a more informative message.
+ procedure Process_Implicit_Dereference_Prefix
+ (E : Entity_Id; P : Node_Id);
+ -- Called when P is the prefix of an implicit dereference, denoting
+ -- an object E. If in semantics only mode (-gnatc), record that P
+ -- is a reference to E. Normally, such a reference is generated only
+ -- when the implicit dereference is expanded into an explicit one.
+ -- E may be empty, in which case this procedure does nothing.
+
procedure Remove_Abstract_Operations (N : Node_Id);
-- Ada 2005: implementation of AI-310. An abstract non-dispatching
-- operation is not a candidate interpretation.
End_Interp_List;
- -- Error if no interpretation of the prefix has an access type.
+ -- Error if no interpretation of the prefix has an access type
if Etype (N) = Any_Type then
Error_Msg_N
Exp : Node_Id;
Array_Type : Entity_Id;
Index : Node_Id;
- Entry_Family : Entity_Id;
+ Pent : Entity_Id := Empty;
begin
Exp := First (Exprs);
else
Array_Type := Etype (P);
- -- Prefix must be appropriate for an array type.
- -- Dereference the prefix if it is an access type.
+ if Is_Entity_Name (P) then
+ Pent := Entity (P);
+ elsif Nkind (P) = N_Selected_Component
+ and then Is_Entity_Name (Selector_Name (P))
+ then
+ Pent := Entity (Selector_Name (P));
+ end if;
+
+ -- Prefix must be appropriate for an array type, taking into
+ -- account a possible implicit dereference.
if Is_Access_Type (Array_Type) then
Array_Type := Designated_Type (Array_Type);
Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
+ Process_Implicit_Dereference_Prefix (Pent, P);
end if;
if Is_Array_Type (Array_Type) then
null;
- elsif (Is_Entity_Name (P)
- and then
- Ekind (Entity (P)) = E_Entry_Family)
- or else
- (Nkind (P) = N_Selected_Component
- and then
- Is_Entity_Name (Selector_Name (P))
- and then
- Ekind (Entity (Selector_Name (P))) = E_Entry_Family)
- then
- if Is_Entity_Name (P) then
- Entry_Family := Entity (P);
- else
- Entry_Family := Entity (Selector_Name (P));
- end if;
-
+ elsif Present (Pent) and then Ekind (Pent) = E_Entry_Family then
Analyze (Exp);
Set_Etype (N, Any_Type);
if not Has_Compatible_Type
- (Exp, Entry_Index_Type (Entry_Family))
+ (Exp, Entry_Index_Type (Pent))
then
Error_Msg_N ("invalid index type in entry name", N);
else
if Nkind (Parent (N)) = N_Requeue_Statement
- and then
- ((Is_Entity_Name (P)
- and then Ekind (Entity (P)) = E_Entry)
- or else
- (Nkind (P) = N_Selected_Component
- and then Is_Entity_Name (Selector_Name (P))
- and then Ekind (Entity (Selector_Name (P))) = E_Entry))
+ and then Present (Pent) and then Ekind (Pent) = E_Entry
then
Error_Msg_N
("REQUEUE does not permit parameters", First (Exprs));
Comp : Entity_Id;
Entity_List : Entity_Id;
Prefix_Type : Entity_Id;
+ Pent : Entity_Id := Empty;
Act_Decl : Node_Id;
In_Scope : Boolean;
Parent_N : Node_Id;
else
Error_Msg_NW (Warn_On_Dereference, "?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;
+ Process_Implicit_Dereference_Prefix (Pent, Name);
end if;
Prefix_Type := Designated_Type (Prefix_Type);
Find_Non_Universal_Interpretations (N, R, Op_Id, T1);
- if Etype (N) = Any_Type then
-
- -- Operator was not visible.
+ -- Case of operator was not visible, Etype still set to Any_Type
+ if Etype (N) = Any_Type then
Found := False;
end if;
end if;
end if;
end Operator_Check;
+ -----------------------------------------
+ -- Process_Implicit_Dereference_Prefix --
+ -----------------------------------------
+
+ procedure Process_Implicit_Dereference_Prefix
+ (E : Entity_Id; P : Entity_Id)
+ is
+ Ref : Node_Id;
+ begin
+ if Operating_Mode = Check_Semantics and then Present (E) 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_Reference_To (E, Sloc (P));
+ Set_Comes_From_Source (Ref, Comes_From_Source (P));
+ Generate_Reference (E, Ref);
+ end if;
+ end Process_Implicit_Dereference_Prefix;
+
--------------------------------
-- Remove_Abstract_Operations --
--------------------------------
if No (It.Nam) then
- -- Removal of abstract operation left no viable candidate.
+ -- Removal of abstract operation left no viable candidate
Set_Etype (N, Any_Type);
Error_Msg_Sloc := Sloc (Abstract_Op);
(Call_Node : Node_Id;
Node_To_Replace : Node_Id) return Boolean
is
- Dummy : Node_Id;
- Elmt : Elmt_Id;
- Prim_Op : Entity_Id;
- Prim_Op_Ref : Node_Id;
- Success : Boolean;
+ Dummy : Node_Id;
+ Elmt : Elmt_Id;
+ Prim_Op : Entity_Id;
+ Prim_Op_Ref : Node_Id;
+ Success : Boolean;
begin
- -- Look for the subprogram in the list of primitive operations.
+ -- Look for the subprogram in the list of primitive operations
Elmt := First_Elmt (Primitive_Operations (Obj_Type));
while Present (Elmt) loop
projects / gcc.git / commitdiff