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

sem_ch4.adb (Process_Implicit_Dereference_Prefix): New subprogram used to record an implicit dereference as a read operation on... 

* sem_ch4.adb (Process_Implicit_Dereference_Prefix): New subprogram
	used to record an implicit dereference as a read operation on its
	prefix when operating under -gnatc. Necessary to avoid spurious
	'variable assigned but never read' warnings in that mode.
	(Process_Indexed_Component, Analyze_Selected_Component): When the prefix
	is a non-overloaded implicit dereference, call the above subprogram to
	ensure proper recording of references.

From-SVN: r91892
This commit is contained in:
Arnaud Charlet 2004-12-08 12:48:22 +01:00
parent 07233820c3
commit 6e73e3ab00
1 changed files with 68 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
gcc/ada/sem_ch4.adb
View File

@ -145,25 +145,25 @@ package body Sem_Ch4 is
(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;
@ -181,7 +181,7 @@ package body Sem_Ch4 is
(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;
@ -212,6 +212,14 @@ package body Sem_Ch4 is
-- 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.
@ -1235,7 +1243,7 @@ package body Sem_Ch4 is
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
@ -1371,7 +1379,7 @@ package body Sem_Ch4 is
Exp : Node_Id;
Array_Type : Entity_Id;
Index : Node_Id;
Entry_Family : Entity_Id;
Pent : Entity_Id := Empty;
begin
Exp := First (Exprs);
@ -1382,38 +1390,32 @@ package body Sem_Ch4 is
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);
@ -1439,13 +1441,7 @@ package body Sem_Ch4 is
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));
@ -2471,6 +2467,7 @@ package body Sem_Ch4 is
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;
@ -2522,6 +2519,14 @@ package body Sem_Ch4 is
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);
@ -3961,10 +3966,9 @@ package body Sem_Ch4 is
Find_Non_Universal_Interpretations (N, R, Op_Id, T1);
-- Case of operator was not visible, Etype still set to Any_Type
if Etype (N) = Any_Type then
-- Operator was not visible.
Found := False;
end if;
end if;
@ -4353,6 +4357,27 @@ package body Sem_Ch4 is
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 --
--------------------------------
@ -4540,7 +4565,7 @@ package body Sem_Ch4 is
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);
@ -4886,14 +4911,14 @@ package body Sem_Ch4 is
(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