diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 26 | ||||
| -rw-r--r-- | gcc/ada/a-convec.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 14 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/ug_words | 2 | ||||
| -rw-r--r-- | gcc/ada/usage.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/vms_data.ads | 4 |
10 files changed, 74 insertions, 23 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b41367816ce..e04f2189c97 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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> diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index 6618e779478..b876e8ee971 100644 --- a/gcc/ada/a-convec.adb +++ b/gcc/ada/a-convec.adb @@ -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; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 61530e38867..98a23a216e6 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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; diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index b7e4bcf16f3..35aab900e2e 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -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}) diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index e999c646b77..1ae4482c006 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -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 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 9e2143ac807..7fba92cead6 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index bc3915568f2..e483d051504 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -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; diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index 61191ef9644..68851c39617 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -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 diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 76d9a25b4a4..136f5545271 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -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"); diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index a8565c3d2e2..b4ee226c673 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -2914,6 +2914,10 @@ package VMS_Data is "-gnatwm " & "NOMODIFIED_UNREF " & "-gnatwM " & + "SUSPICIOUS_MODULUS " & + "-gnatw.m " & + "NOSUSPICIOUS_MODULUS " & + "-gnatw.M " & "NORMAL " & "-gnatwn " & "OVERLAYS " & |