OSDN Git Service

2009-07-13 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 13 Jul 2009 08:22:58 +0000 (08:22 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 13 Jul 2009 08:22:58 +0000 (08:22 +0000)
* freeze.adb (Freeze_Entity): Implement Warn_On_Suspicious_Modulus_Value

* gnat_ugn.texi: Add documentation for -gnatw.m/.M

* opt.ads (Warn_On_Suspicious_Modulus_Value): New flag

* sem_warn.adb (Set_Dot_Warning_Flag): Set/reset
Warn_On_Suspicious_Modulus_Value.

* ug_words: Add entries for -gnatw.m/-gnatw.M.

* usage.adb: Add lines for -gnatw.m/.M switches.

* vms_data.ads: Add [NO]SUSPICIOUS_MODULUS for -gnatw.m/w.M

2009-07-13  Javier Miranda  <miranda@adacore.com>

* sem_ch6.adb (Check_Synchronized_Overriding): Add missing check before
reading the Is_Interface attribute of the dispatching type.

2009-07-13  Robert Dewar  <dewar@adacore.com>

* a-convec.adb: Minor code reorganization (use conditional expressions)

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149550 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/a-convec.adb
gcc/ada/freeze.adb
gcc/ada/gnat_ugn.texi
gcc/ada/opt.ads
gcc/ada/sem_ch6.adb
gcc/ada/sem_warn.adb
gcc/ada/ug_words
gcc/ada/usage.adb
gcc/ada/vms_data.ads

index b413678..e04f218 100644 (file)
@@ -1,5 +1,31 @@
 2009-07-13  Robert Dewar  <dewar@adacore.com>
 
+       * freeze.adb (Freeze_Entity): Implement Warn_On_Suspicious_Modulus_Value
+
+       * gnat_ugn.texi: Add documentation for -gnatw.m/.M
+
+       * opt.ads (Warn_On_Suspicious_Modulus_Value): New flag
+
+       * sem_warn.adb (Set_Dot_Warning_Flag): Set/reset
+       Warn_On_Suspicious_Modulus_Value.
+
+       * ug_words: Add entries for -gnatw.m/-gnatw.M.
+
+       * usage.adb: Add lines for -gnatw.m/.M switches.
+
+       * vms_data.ads: Add [NO]SUSPICIOUS_MODULUS for -gnatw.m/w.M
+
+2009-07-13  Javier Miranda  <miranda@adacore.com>
+
+       * sem_ch6.adb (Check_Synchronized_Overriding): Add missing check before
+       reading the Is_Interface attribute of the dispatching type.
+
+2009-07-13  Robert Dewar  <dewar@adacore.com>
+
+       * a-convec.adb: Minor code reorganization (use conditional expressions)
+
+2009-07-13  Robert Dewar  <dewar@adacore.com>
+
        * freeze.adb (Check_Suspicious_Modulus): New procedure.
 
 2009-07-13  Robert Dewar  <dewar@adacore.com>
index 6618e77..b876e8e 100644 (file)
@@ -485,11 +485,10 @@ package body Ada.Containers.Vectors is
 
       Index := Int'Base (Container.Last) - Int'Base (Count);
 
-      if Index < Index_Type'Pos (Index_Type'First) then
-         Container.Last := No_Index;
-      else
-         Container.Last := Index_Type (Index);
-      end if;
+      Container.Last :=
+         (if Index < Index_Type'Pos (Index_Type'First)
+          then No_Index
+          else Index_Type (Index));
    end Delete_Last;
 
    -------------
@@ -881,7 +880,6 @@ package body Ada.Containers.Vectors is
            and then Index_Type'Last >= 0
          then
             CC := UInt (Index_Type'Last) + UInt (-Index_Type'First) + 1;
-
          else
             CC := UInt (Int (Index_Type'Last) - First + 1);
          end if;
@@ -1325,7 +1323,6 @@ package body Ada.Containers.Vectors is
            and then Index_Type'Last >= 0
          then
             CC := UInt (Index_Type'Last) + UInt (-Index_Type'First) + 1;
-
          else
             CC := UInt (Int (Index_Type'Last) - First + 1);
          end if;
@@ -1953,13 +1950,10 @@ package body Ada.Containers.Vectors is
          raise Program_Error with "Position cursor denotes wrong container";
       end if;
 
-      if Position.Container = null
-        or else Position.Index > Container.Last
-      then
-         Last := Container.Last;
-      else
-         Last := Position.Index;
-      end if;
+      Last :=
+        (if Position.Container = null or else Position.Index > Container.Last
+         then Container.Last
+         else Position.Index);
 
       for Indx in reverse Index_Type'First .. Last loop
          if Container.Elements.EA (Indx) = Item then
@@ -1979,15 +1973,10 @@ package body Ada.Containers.Vectors is
       Item      : Element_Type;
       Index     : Index_Type := Index_Type'Last) return Extended_Index
    is
-      Last : Index_Type'Base;
+      Last : constant Index_Type'Base :=
+               Index_Type'Min (Container.Last, Index);
 
    begin
-      if Index > Container.Last then
-         Last := Container.Last;
-      else
-         Last := Index;
-      end if;
-
       for Indx in reverse Index_Type'First .. Last loop
          if Container.Elements.EA (Indx) = Item then
             return Indx;
index 61530e3..98a23a2 100644 (file)
@@ -3692,7 +3692,9 @@ package body Freeze is
          elsif Is_Integer_Type (E) then
             Adjust_Esize_For_Alignment (E);
 
-            if Is_Modular_Integer_Type (E) then
+            if Is_Modular_Integer_Type (E)
+              and then Warn_On_Suspicious_Modulus_Value
+            then
                Check_Suspicious_Modulus (E);
             end if;
 
index b7e4bcf..35aab90 100644 (file)
@@ -5347,6 +5347,20 @@ The default is that these warnings are not given.
 This switch disables warnings for variables that are assigned or
 initialized, but never read.
 
+@item -gnatw.m
+@emph{Activate warnings on suspicious modulus values.}
+@cindex @option{-gnatw.m} (@command{gcc})
+This switch activates warnings for modulus values that seem suspicious.
+The cases caught are where the size is the same as the modulus (e.g.
+a modulus of 7 with a size of 7 bits), and modulus values of 32 or 64
+with no size clause. The guess in both cases is that 2**x was intended
+rather than x. The default is that these warnings are given.
+
+@item -gnatw.M
+@emph{Disable warnings on suspicious modulus values.}
+@cindex @option{-gnatw.M} (@command{gcc})
+This switch disables warnings for suspicious modulus values.
+
 @item -gnatwn
 @emph{Set normal warnings mode.}
 @cindex @option{-gnatwn} (@command{gcc})
index e999c64..1ae4482 100644 (file)
@@ -1377,6 +1377,11 @@ package Opt is
    --  clauses that are affected by non-standard bit-order. The default is
    --  that this warning is enabled.
 
+   Warn_On_Suspicious_Modulus_Value : Boolean := True;
+   --  GNAT
+   --  Set to True to generate warnings for suspicious modulus values. The
+   --  default is that this warning is enabled.
+
    Warn_On_Unchecked_Conversion : Boolean := True;
    --  GNAT
    --  Set to True to generate warnings for unchecked conversions that may have
index 9e2143a..7fba92c 100644 (file)
@@ -7175,6 +7175,7 @@ package body Sem_Ch6 is
                  or else not Is_Overloadable (Subp)
                  or else not Is_Primitive (Subp)
                  or else not Is_Dispatching_Operation (Subp)
+                 or else not Present (Find_Dispatching_Type (Subp))
                  or else not Is_Interface (Find_Dispatching_Type (Subp))
                then
                   null;
index bc39155..e483d05 100644 (file)
@@ -2997,6 +2997,12 @@ package body Sem_Warn is
             Warn_On_Unrepped_Components         := True;
             Warn_On_Warnings_Off                := True;
 
+         when 'm' =>
+            Warn_On_Suspicious_Modulus_Value    := True;
+
+         when 'M' =>
+            Warn_On_Suspicious_Modulus_Value    := False;
+
          when 'o' =>
             Warn_On_All_Unread_Out_Parameters   := True;
 
index 61191ef..68851c3 100644 (file)
@@ -148,6 +148,8 @@ gcc -c          ^ GNAT COMPILE
 -gnatwL         ^ /WARNINGS=NOELABORATION
 -gnatwm         ^ /WARNINGS=MODIFIED_UNREF
 -gnatwM         ^ /WARNINGS=NOMODIFIED_UNREF
+-gnatw.m        ^ /WARNINGS=SUSPICIOUS_MODULUES
+-gnatw.M        ^ /WARNINGS=NOSUSPICIOUS_MODULUES
 -gnatwn         ^ /WARNINGS=NORMAL
 -gnatwo         ^ /WARNINGS=OVERLAYS
 -gnatwO         ^ /WARNINGS=NOOVERLAYS
index 76d9a25..136f554 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                B o d y                                   --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, 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- --
@@ -428,6 +428,8 @@ begin
                                                   "but not read");
    Write_Line ("        M*   turn off warnings for variable assigned " &
                                                   "but not read");
+   Write_Line ("        .m*  turn on warnings for suspicious modulus value");
+   Write_Line ("        .M   turn off warnings for suspicious modulus value");
    Write_Line ("        n*   normal warning mode (cancels -gnatws/-gnatwe)");
    Write_Line ("        o*   turn on warnings for address clause overlay");
    Write_Line ("        O    turn off warnings for address clause overlay");
index a8565c3..b4ee226 100644 (file)
@@ -2914,6 +2914,10 @@ package VMS_Data is
                                                "-gnatwm "                  &
                                             "NOMODIFIED_UNREF "            &
                                                "-gnatwM "                  &
+                                            "SUSPICIOUS_MODULUS "          &
+                                               "-gnatw.m "                 &
+                                            "NOSUSPICIOUS_MODULUS "        &
+                                               "-gnatw.M "                 &
                                             "NORMAL "                      &
                                                "-gnatwn "                  &
                                             "OVERLAYS "                    &