[Ada] Improve message for condition always False (simple variable case)

Arnaud Charlet charlet@adacore.com
Fri Jan 30 15:58:00 GMT 2015


The warning message for an always True condition special cased the
simple variable case. This special casing is now extended for the
False case as well:

     1. package CCF_Warn is
     2.    procedure Mess;
     3. end;

     1. package body CCF_Warn is
     2.     type T is array (1..10) of Integer;
     3.     Thing : T := (others => 111);
     4.
     5.     procedure Change (X : integer; Y : out Boolean) is
     6.     begin
     7.         Y := X > 17;
     8.     end Change;
     9.
    10.    procedure Mess is
    11.     Blinking   : Boolean;
    12.     Some_Blink : Boolean;
    13.    begin
    14.
    15.      Blinking := False;
    16.      Some_Blink := False;
    17.
    18.      if Thing (3) = Thing (5) then
    19.         Change (10, Some_Blink);
    20.
    21.         Blinking := Blinking or Some_Blink;
                            |
        >>> warning: object "Blinking" is always False
        >>> warning: (see assignment at line 15)

    22.
    23.      else
    24.         for X in T'range loop
    25.           Thing (X) := -1;
    26.         end loop;
    27.      end if;
    28.    end;
    29. end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2015-01-30  Robert Dewar  <dewar@adacore.com>

	* sem_warn.adb (Warn_On_Known_Condition): Do special casing of
	message for False case.

-------------- next part --------------
Index: sem_warn.adb
===================================================================
--- sem_warn.adb	(revision 220273)
+++ sem_warn.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -3390,18 +3390,22 @@
                Cond        : Node_Id := C;
 
             begin
-               if Present (Parent (C)) and then Nkind (Parent (C)) = N_Op_Not
+               if Present (Parent (C))
+                 and then Nkind (Parent (C)) = N_Op_Not
                then
                   True_Branch := not True_Branch;
-                  Cond        := Parent (C);
+                  Cond := Parent (C);
                end if;
 
+               --  Condition always True
+
                if True_Branch then
                   if Is_Entity_Name (Original_Node (C))
                     and then Nkind (Cond) /= N_Op_Not
                   then
                      Error_Msg_NE
-                       ("object & is always True?c?", Cond, Original_Node (C));
+                       ("object & is always True?c?",
+                        Cond, Original_Node (C));
                      Track (Original_Node (C), Cond);
 
                   else
@@ -3409,9 +3413,21 @@
                      Track (Cond, Cond);
                   end if;
 
+               --  Condition always False
+
                else
-                  Error_Msg_N ("condition is always False?c?", Cond);
-                  Track (Cond, Cond);
+                  if Is_Entity_Name (Original_Node (C))
+                    and then Nkind (Cond) /= N_Op_Not
+                  then
+                     Error_Msg_NE
+                       ("object & is always False?c?",
+                        Cond, Original_Node (C));
+                     Track (Original_Node (C), Cond);
+
+                  else
+                     Error_Msg_N ("condition is always False?c?", Cond);
+                     Track (Cond, Cond);
+                  end if;
                end if;
             end;
          end if;


More information about the Gcc-patches mailing list