This patch corrects the placement of an error message concerning a redundant
comparison to True. The patch also add machinery to explain the nature of the
redundant True.
------------
-- Source --
------------
-- main.adb
procedure Main is
type Rec (Discr : Boolean) is null record;
function Self (Flag : Boolean) return Boolean is
begin
return Flag;
end Self;
Obj : constant Rec := Rec'(Discr => True);
begin
if Self (True) = Obj.Discr then
null;
end if;
end Main;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -c -gnatwa main.adb
main.adb:12:19: warning: comparison with True is redundant
main.adb:12:25: warning: discriminant "Discr" is always True
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-04-24 Hristian Kirtchev <kirtc...@adacore.com>
* sem_res.adb (Explain_Redundancy): New routine.
(Resolve_Equality_Op): Place the error concerning a redundant
comparison to True at the "=". Try to explain the nature of the
redundant True.
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 198234)
+++ sem_res.adb (working copy)
@@ -6821,6 +6821,11 @@
-- impose an expected type (as can be the case in an equality operation)
-- the expression must be rejected.
+ procedure Explain_Redundancy (N : Node_Id);
+ -- Attempt to explain the nature of a redundant comparison with True. If
+ -- the expression N is too complex, this routine issues a general error
+ -- message.
+
function Find_Unique_Access_Type return Entity_Id;
-- In the case of allocators and access attributes, the context must
-- provide an indication of the specific access type to be used. If
@@ -6850,6 +6855,72 @@
end if;
end Check_If_Expression;
+ ------------------------
+ -- Explain_Redundancy --
+ ------------------------
+
+ procedure Explain_Redundancy (N : Node_Id) is
+ Error : Name_Id;
+ Val : Node_Id;
+ Val_Id : Entity_Id;
+
+ begin
+ Val := N;
+
+ -- Strip the operand down to an entity
+
+ loop
+ if Nkind (Val) = N_Selected_Component then
+ Val := Selector_Name (Val);
+ else
+ exit;
+ end if;
+ end loop;
+
+ -- The construct denotes an entity
+
+ if Is_Entity_Name (Val) and then Present (Entity (Val)) then
+ Val_Id := Entity (Val);
+
+ -- Do not generate an error message when the comparison is done
+ -- against the enumeration literal Standard.True.
+
+ if Ekind (Val_Id) /= E_Enumeration_Literal then
+
+ -- Build a customized error message
+
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer ("?r?");
+
+ if Ekind (Val_Id) = E_Component then
+ Add_Str_To_Name_Buffer ("component ");
+
+ elsif Ekind (Val_Id) = E_Constant then
+ Add_Str_To_Name_Buffer ("constant ");
+
+ elsif Ekind (Val_Id) = E_Discriminant then
+ Add_Str_To_Name_Buffer ("discriminant ");
+
+ elsif Is_Formal (Val_Id) then
+ Add_Str_To_Name_Buffer ("parameter ");
+
+ elsif Ekind (Val_Id) = E_Variable then
+ Add_Str_To_Name_Buffer ("variable ");
+ end if;
+
+ Add_Str_To_Name_Buffer ("& is always True!");
+ Error := Name_Find;
+
+ Error_Msg_NE (Get_Name_String (Error), Val, Val_Id);
+ end if;
+
+ -- The construct is too complex to disect, issue a general message
+
+ else
+ Error_Msg_N ("?r?expression is always True!", Val);
+ end if;
+ end Explain_Redundancy;
+
-----------------------------
-- Find_Unique_Access_Type --
-----------------------------
@@ -6979,12 +7050,13 @@
if Warn_On_Redundant_Constructs
and then Comes_From_Source (N)
+ and then Comes_From_Source (R)
and then Is_Entity_Name (R)
and then Entity (R) = Standard_True
- and then Comes_From_Source (R)
then
Error_Msg_N -- CODEFIX
- ("?r?comparison with True is redundant!", R);
+ ("?r?comparison with True is redundant!", N);
+ Explain_Redundancy (Original_Node (R));
end if;
Check_Unset_Reference (L);
