GNAT did not issue a warning when assigning to a part of an object, and not
referencing the object later on. Now it does so in some cases, similarly to
the existing warnings on assignment to elementary objects.
On the code below, GNAT now issues warnings:
$ gcc -c -gnatwa assign.adb
assign.adb:8:05: warning: useless assignment to "X", value never referenced
assign.adb:9:04: warning: useless assignment to "Y", value never referenced
---
procedure Assign is
type T is record
U : Integer;
end record;
X : T := T'(U => 0);
Y : array (1..2) of Integer := (others => 0);
begin
X.U := X.U + 1;
Y (2) := Y (1);
end Assign;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-04 Yannick Moy <m...@adacore.com>
* checks.adb (Apply_Float_Conversion_Check): correct a typo where Lo_OK
was used instead of Hi_OK, which could cause a read of an uninitialized
value later on. Detected while working on the new warning.
* exp_ch9.adb (Expand_N_Entry_Declaration): remove useless assignment
to local variable.
* sem_ch5.adb (Analyze_Assignment): set the last assignment component
in more cases, in order to detect more unreferenced values.
* sem_util.adb, sem_util.ads (Get_Enclosing_Object): return enclosing
object for expression, if any.
Index: sem_ch5.adb
===================================================================
--- sem_ch5.adb (revision 177353)
+++ sem_ch5.adb (working copy)
@@ -746,22 +746,17 @@
if Safe_To_Capture_Value (N, Ent) then
-- If simple variable on left side, warn if this assignment
- -- blots out another one (rendering it useless) and note
- -- location of assignment in case no one references value. We
- -- only do this for source assignments, otherwise we can
- -- generate bogus warnings when an assignment is rewritten as
- -- another assignment, and gets tied up with itself.
+ -- blots out another one (rendering it useless). We only do
+ -- this for source assignments, otherwise we can generate bogus
+ -- warnings when an assignment is rewritten as another
+ -- assignment, and gets tied up with itself.
- -- Note: we don't use Record_Last_Assignment here, because we
- -- have lots of other stuff to do under control of this test.
-
if Warn_On_Modified_Unread
and then Is_Assignable (Ent)
and then Comes_From_Source (N)
and then In_Extended_Main_Source_Unit (Ent)
then
Warn_On_Useless_Assignment (Ent, N);
- Set_Last_Assignment (Ent, Lhs);
end if;
-- If we are assigning an access type and the left side is an
@@ -803,6 +798,28 @@
end if;
end;
end if;
+
+ -- If assigning to an object in whole or in part, note location of
+ -- assignment in case no one references value. We only do this for
+ -- source assignments, otherwise we can generate bogus warnings when an
+ -- assignment is rewritten as another assignment, and gets tied up with
+ -- itself.
+
+ declare
+ Ent : constant Entity_Id := Get_Enclosing_Object (Lhs);
+
+ begin
+ if Present (Ent)
+ and then Safe_To_Capture_Value (N, Ent)
+ and then Nkind (N) = N_Assignment_Statement
+ and then Warn_On_Modified_Unread
+ and then Is_Assignable (Ent)
+ and then Comes_From_Source (N)
+ and then In_Extended_Main_Source_Unit (Ent)
+ then
+ Set_Last_Assignment (Ent, Lhs);
+ end if;
+ end;
end Analyze_Assignment;
-----------------------------
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 177344)
+++ exp_ch9.adb (working copy)
@@ -7330,7 +7330,6 @@
Subtype_Indication => New_Reference_To (Rec_Ent, Loc)));
Insert_After (Last_Decl, Decl);
- Last_Decl := Decl;
end if;
end Expand_N_Entry_Declaration;
Index: checks.adb
===================================================================
--- checks.adb (revision 177318)
+++ checks.adb (working copy)
@@ -1690,7 +1690,7 @@
if Truncate and then Ilast < 0 then
Hi := Succ (Expr_Type, UR_From_Uint (Ilast));
- Lo_OK := False;
+ Hi_OK := False;
elsif Truncate then
Hi := Pred (Expr_Type, UR_From_Uint (Ilast + 1));
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 177353)
+++ sem_util.adb (working copy)
@@ -4151,6 +4151,38 @@
Strval => String_From_Name_Buffer);
end Get_Default_External_Name;
+ --------------------------
+ -- Get_Enclosing_Object --
+ --------------------------
+
+ function Get_Enclosing_Object (N : Node_Id) return Entity_Id is
+ begin
+ if Is_Entity_Name (N) then
+ return Entity (N);
+ else
+ case Nkind (N) is
+ when N_Indexed_Component |
+ N_Slice |
+ N_Selected_Component =>
+
+ -- If not generating code, a dereference may be left implicit.
+ -- In thoses cases, return Empty.
+
+ if Is_Access_Type (Etype (Prefix (N))) then
+ return Empty;
+ else
+ return Get_Enclosing_Object (Prefix (N));
+ end if;
+
+ when N_Type_Conversion =>
+ return Get_Enclosing_Object (Expression (N));
+
+ when others =>
+ return Empty;
+ end case;
+ end if;
+ end Get_Enclosing_Object;
+
---------------------------
-- Get_Enum_Lit_From_Pos --
---------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 177353)
+++ sem_util.ads (working copy)
@@ -480,6 +480,10 @@
-- identifier provided as the external name. Letters in the name are
-- according to the setting of Opt.External_Name_Default_Casing.
+ function Get_Enclosing_Object (N : Node_Id) return Entity_Id;
+ -- If expression N references a part of an object, return this object.
+ -- Otherwise return Empty. Expression N should have been resolved already.
+
function Get_Generic_Entity (N : Node_Id) return Entity_Id;
-- Returns the true generic entity in an instantiation. If the name in the
-- instantiation is a renaming, the function returns the renamed generic.
