===================================================================
@@ -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;
-----------------------------
===================================================================
@@ -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;
===================================================================
@@ -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));
===================================================================
@@ -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 --
---------------------------
===================================================================
@@ -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.
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 <moy@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.