Commit 2717634d by Arnaud Charlet

exp_ch4.adb (Expand_N_Indexed_Component): For an indexed component with an…

exp_ch4.adb (Expand_N_Indexed_Component): For an indexed component with an implicit dereference as its prefix...

	* exp_ch4.adb (Expand_N_Indexed_Component): For an indexed component
	with an implicit dereference as its prefix, use
	Insert_Explicit_Dereference instead of merely rewriting the prefix into
	an explicit dereference. This ensures that a reference to the original
	prefix is generated, if appropriate.

	* sem_util.adb (Insert_Explicit_Dereference): When an implicit
	dereference is rewritten to an explicit one, generate a reference to
	the entity denoted by its prefix using the original prefix node, so
	the dereference can be properly recorded as a read of the denoted
	access value, if appropriate.

	* sem_warn.adb (Output_Unreferenced_Messages): Do not abstain from
	emitting 'assigned but never read' warning on a variable on the basis
	that it has an access type.
	(Check_References): Emit unreferenced warning when the scope is a
	subprogram body.

From-SVN: r91881
parent e913f03b
...@@ -1780,7 +1780,7 @@ package body Exp_Ch4 is ...@@ -1780,7 +1780,7 @@ package body Exp_Ch4 is
-- end loop; -- end loop;
-- end if; -- end if;
-- ... -- . . .
-- if Sn'Length /= 0 then -- if Sn'Length /= 0 then
-- P := Sn'First; -- P := Sn'First;
...@@ -2914,7 +2914,7 @@ package body Exp_Ch4 is ...@@ -2914,7 +2914,7 @@ package body Exp_Ch4 is
-- Cnn := else-expr -- Cnn := else-expr
-- end if; -- end if;
-- and replace the conditional expression by a reference to Cnn. -- and replace the conditional expression by a reference to Cnn
if Present (Then_Actions (N)) or else Present (Else_Actions (N)) then if Present (Then_Actions (N)) or else Present (Else_Actions (N)) then
Cnn := Make_Defining_Identifier (Loc, New_Internal_Name ('C')); Cnn := Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
...@@ -3273,9 +3273,7 @@ package body Exp_Ch4 is ...@@ -3273,9 +3273,7 @@ package body Exp_Ch4 is
-- was necessary, but it cleans up the code to do it all the time. -- was necessary, but it cleans up the code to do it all the time.
if Is_Access_Type (T) then if Is_Access_Type (T) then
Rewrite (P, Insert_Explicit_Dereference (P);
Make_Explicit_Dereference (Sloc (N),
Prefix => Relocate_Node (P)));
Analyze_And_Resolve (P, Designated_Type (T)); Analyze_And_Resolve (P, Designated_Type (T));
end if; end if;
...@@ -3921,7 +3919,7 @@ package body Exp_Ch4 is ...@@ -3921,7 +3919,7 @@ package body Exp_Ch4 is
-- Obj1 : Enclosing_UU_Type; -- Obj1 : Enclosing_UU_Type;
-- Obj2 : Enclosing_UU_Type (1); -- Obj2 : Enclosing_UU_Type (1);
-- . . . Obj1 = Obj2 . . . -- [. . .] Obj1 = Obj2 [. . .]
-- Generated code: -- Generated code:
...@@ -6735,7 +6733,7 @@ package body Exp_Ch4 is ...@@ -6735,7 +6733,7 @@ package body Exp_Ch4 is
-- ityp (x) -- ityp (x)
-- with the Float_Truncate flag set. This is clearly more efficient. -- with the Float_Truncate flag set. This is clearly more efficient
if Nkind (Operand) = N_Attribute_Reference if Nkind (Operand) = N_Attribute_Reference
and then Attribute_Name (Operand) = Name_Truncation and then Attribute_Name (Operand) = Name_Truncation
......
...@@ -2631,7 +2631,7 @@ package body Sem_Util is ...@@ -2631,7 +2631,7 @@ package body Sem_Util is
begin begin
Get_Unit_Name_String (Unit_Name_Id); Get_Unit_Name_String (Unit_Name_Id);
-- Remove seven last character (" (spec)" or " (body)"). -- Remove seven last character (" (spec)" or " (body)")
Name_Len := Name_Len - 7; Name_Len := Name_Len - 7;
pragma Assert (Name_Buffer (Name_Len + 1) = ' '); pragma Assert (Name_Buffer (Name_Len + 1) = ' ');
...@@ -3136,6 +3136,7 @@ package body Sem_Util is ...@@ -3136,6 +3136,7 @@ package body Sem_Util is
procedure Insert_Explicit_Dereference (N : Node_Id) is procedure Insert_Explicit_Dereference (N : Node_Id) is
New_Prefix : constant Node_Id := Relocate_Node (N); New_Prefix : constant Node_Id := Relocate_Node (N);
Ent : Entity_Id := Empty;
I : Interp_Index; I : Interp_Index;
It : Interp; It : Interp;
T : Entity_Id; T : Entity_Id;
...@@ -3166,6 +3167,21 @@ package body Sem_Util is ...@@ -3166,6 +3167,21 @@ package body Sem_Util is
end loop; end loop;
End_Interp_List; End_Interp_List;
else
-- Prefix is unambiguous: mark the original prefix (which might
-- Come_From_Source) as a reference, since the new (relocated) one
-- won't be taken into account.
if Is_Entity_Name (New_Prefix) then
Ent := Entity (New_Prefix);
elsif Nkind (New_Prefix) = N_Selected_Component then
Ent := Entity (Selector_Name (New_Prefix));
end if;
if Present (Ent) then
Generate_Reference (Ent, New_Prefix);
end if;
end if; end if;
end Insert_Explicit_Dereference; end Insert_Explicit_Dereference;
......
...@@ -563,6 +563,7 @@ package body Sem_Warn is ...@@ -563,6 +563,7 @@ package body Sem_Warn is
(Ekind (E) = E_Function (Ekind (E) = E_Function
or else Ekind (E) = E_Package_Body or else Ekind (E) = E_Package_Body
or else Ekind (E) = E_Procedure or else Ekind (E) = E_Procedure
or else Ekind (E) = E_Subprogram_Body
or else Ekind (E) = E_Block))) or else Ekind (E) = E_Block)))
-- Exclude instantiations, since there is no reason why -- Exclude instantiations, since there is no reason why
...@@ -670,7 +671,7 @@ package body Sem_Warn is ...@@ -670,7 +671,7 @@ package body Sem_Warn is
Unreferenced_Entities.Increment_Last; Unreferenced_Entities.Increment_Last;
Unreferenced_Entities.Table (Unreferenced_Entities.Last) := E1; Unreferenced_Entities.Table (Unreferenced_Entities.Last) := E1;
-- Force warning on entity. -- Force warning on entity
Set_Referenced (E1, False); Set_Referenced (E1, False);
end if; end if;
...@@ -994,7 +995,7 @@ package body Sem_Warn is ...@@ -994,7 +995,7 @@ package body Sem_Warn is
Un : constant Node_Id := Sinfo.Unit (Cnode); Un : constant Node_Id := Sinfo.Unit (Cnode);
function Check_Use_Clause (N : Node_Id) return Traverse_Result; function Check_Use_Clause (N : Node_Id) return Traverse_Result;
-- If N is a use_clause for Pack, emit warning. -- If N is a use_clause for Pack, emit warning
procedure Check_Use_Clauses is new procedure Check_Use_Clauses is new
Traverse_Proc (Check_Use_Clause); Traverse_Proc (Check_Use_Clause);
...@@ -1484,22 +1485,13 @@ package body Sem_Warn is ...@@ -1484,22 +1485,13 @@ package body Sem_Warn is
if Warn_On_Modified_Unread if Warn_On_Modified_Unread
and then not Is_Imported (E) and then not Is_Imported (E)
-- Suppress the message for aliased, renamed -- Suppress the message for aliased or renamed
-- and access variables since there may be -- variables, since there may be other entities
-- other entities that read the memory location. -- read the same memory location.
and then not Is_Aliased (E) and then not Is_Aliased (E)
and then No (Renamed_Object (E)) and then No (Renamed_Object (E))
and then not (Is_Access_Type (Etype (E))
or else
-- Case of private access type, must examine the
-- full view due to visibility issues.
(Is_Private_Type (Etype (E))
and then
Is_Access_Type
(Full_View (Etype (E)))))
then then
Error_Msg_N Error_Msg_N
("variable & is assigned but never read?", E); ("variable & is assigned but never read?", E);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment