Commit 79afa047 by Arnaud Charlet

[multiple changes]

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)

From-SVN: r149550
parent 67b3acf8
2009-07-13 Robert Dewar <dewar@adacore.com> 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. * freeze.adb (Check_Suspicious_Modulus): New procedure.
2009-07-13 Robert Dewar <dewar@adacore.com> 2009-07-13 Robert Dewar <dewar@adacore.com>
......
...@@ -485,11 +485,10 @@ package body Ada.Containers.Vectors is ...@@ -485,11 +485,10 @@ package body Ada.Containers.Vectors is
Index := Int'Base (Container.Last) - Int'Base (Count); Index := Int'Base (Container.Last) - Int'Base (Count);
if Index < Index_Type'Pos (Index_Type'First) then Container.Last :=
Container.Last := No_Index; (if Index < Index_Type'Pos (Index_Type'First)
else then No_Index
Container.Last := Index_Type (Index); else Index_Type (Index));
end if;
end Delete_Last; end Delete_Last;
------------- -------------
...@@ -881,7 +880,6 @@ package body Ada.Containers.Vectors is ...@@ -881,7 +880,6 @@ package body Ada.Containers.Vectors is
and then Index_Type'Last >= 0 and then Index_Type'Last >= 0
then then
CC := UInt (Index_Type'Last) + UInt (-Index_Type'First) + 1; CC := UInt (Index_Type'Last) + UInt (-Index_Type'First) + 1;
else else
CC := UInt (Int (Index_Type'Last) - First + 1); CC := UInt (Int (Index_Type'Last) - First + 1);
end if; end if;
...@@ -1325,7 +1323,6 @@ package body Ada.Containers.Vectors is ...@@ -1325,7 +1323,6 @@ package body Ada.Containers.Vectors is
and then Index_Type'Last >= 0 and then Index_Type'Last >= 0
then then
CC := UInt (Index_Type'Last) + UInt (-Index_Type'First) + 1; CC := UInt (Index_Type'Last) + UInt (-Index_Type'First) + 1;
else else
CC := UInt (Int (Index_Type'Last) - First + 1); CC := UInt (Int (Index_Type'Last) - First + 1);
end if; end if;
...@@ -1953,13 +1950,10 @@ package body Ada.Containers.Vectors is ...@@ -1953,13 +1950,10 @@ package body Ada.Containers.Vectors is
raise Program_Error with "Position cursor denotes wrong container"; raise Program_Error with "Position cursor denotes wrong container";
end if; end if;
if Position.Container = null Last :=
or else Position.Index > Container.Last (if Position.Container = null or else Position.Index > Container.Last
then then Container.Last
Last := Container.Last; else Position.Index);
else
Last := Position.Index;
end if;
for Indx in reverse Index_Type'First .. Last loop for Indx in reverse Index_Type'First .. Last loop
if Container.Elements.EA (Indx) = Item then if Container.Elements.EA (Indx) = Item then
...@@ -1979,15 +1973,10 @@ package body Ada.Containers.Vectors is ...@@ -1979,15 +1973,10 @@ package body Ada.Containers.Vectors is
Item : Element_Type; Item : Element_Type;
Index : Index_Type := Index_Type'Last) return Extended_Index Index : Index_Type := Index_Type'Last) return Extended_Index
is is
Last : Index_Type'Base; Last : constant Index_Type'Base :=
Index_Type'Min (Container.Last, Index);
begin begin
if Index > Container.Last then
Last := Container.Last;
else
Last := Index;
end if;
for Indx in reverse Index_Type'First .. Last loop for Indx in reverse Index_Type'First .. Last loop
if Container.Elements.EA (Indx) = Item then if Container.Elements.EA (Indx) = Item then
return Indx; return Indx;
......
...@@ -3692,7 +3692,9 @@ package body Freeze is ...@@ -3692,7 +3692,9 @@ package body Freeze is
elsif Is_Integer_Type (E) then elsif Is_Integer_Type (E) then
Adjust_Esize_For_Alignment (E); 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); Check_Suspicious_Modulus (E);
end if; end if;
......
...@@ -5347,6 +5347,20 @@ The default is that these warnings are not given. ...@@ -5347,6 +5347,20 @@ The default is that these warnings are not given.
This switch disables warnings for variables that are assigned or This switch disables warnings for variables that are assigned or
initialized, but never read. 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 @item -gnatwn
@emph{Set normal warnings mode.} @emph{Set normal warnings mode.}
@cindex @option{-gnatwn} (@command{gcc}) @cindex @option{-gnatwn} (@command{gcc})
...@@ -1377,6 +1377,11 @@ package Opt is ...@@ -1377,6 +1377,11 @@ package Opt is
-- clauses that are affected by non-standard bit-order. The default is -- clauses that are affected by non-standard bit-order. The default is
-- that this warning is enabled. -- 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; Warn_On_Unchecked_Conversion : Boolean := True;
-- GNAT -- GNAT
-- Set to True to generate warnings for unchecked conversions that may have -- Set to True to generate warnings for unchecked conversions that may have
......
...@@ -7175,6 +7175,7 @@ package body Sem_Ch6 is ...@@ -7175,6 +7175,7 @@ package body Sem_Ch6 is
or else not Is_Overloadable (Subp) or else not Is_Overloadable (Subp)
or else not Is_Primitive (Subp) or else not Is_Primitive (Subp)
or else not Is_Dispatching_Operation (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)) or else not Is_Interface (Find_Dispatching_Type (Subp))
then then
null; null;
......
...@@ -2997,6 +2997,12 @@ package body Sem_Warn is ...@@ -2997,6 +2997,12 @@ package body Sem_Warn is
Warn_On_Unrepped_Components := True; Warn_On_Unrepped_Components := True;
Warn_On_Warnings_Off := True; Warn_On_Warnings_Off := True;
when 'm' =>
Warn_On_Suspicious_Modulus_Value := True;
when 'M' =>
Warn_On_Suspicious_Modulus_Value := False;
when 'o' => when 'o' =>
Warn_On_All_Unread_Out_Parameters := True; Warn_On_All_Unread_Out_Parameters := True;
......
...@@ -148,6 +148,8 @@ gcc -c ^ GNAT COMPILE ...@@ -148,6 +148,8 @@ gcc -c ^ GNAT COMPILE
-gnatwL ^ /WARNINGS=NOELABORATION -gnatwL ^ /WARNINGS=NOELABORATION
-gnatwm ^ /WARNINGS=MODIFIED_UNREF -gnatwm ^ /WARNINGS=MODIFIED_UNREF
-gnatwM ^ /WARNINGS=NOMODIFIED_UNREF -gnatwM ^ /WARNINGS=NOMODIFIED_UNREF
-gnatw.m ^ /WARNINGS=SUSPICIOUS_MODULUES
-gnatw.M ^ /WARNINGS=NOSUSPICIOUS_MODULUES
-gnatwn ^ /WARNINGS=NORMAL -gnatwn ^ /WARNINGS=NORMAL
-gnatwo ^ /WARNINGS=OVERLAYS -gnatwo ^ /WARNINGS=OVERLAYS
-gnatwO ^ /WARNINGS=NOOVERLAYS -gnatwO ^ /WARNINGS=NOOVERLAYS
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -428,6 +428,8 @@ begin ...@@ -428,6 +428,8 @@ begin
"but not read"); "but not read");
Write_Line (" M* turn off warnings for variable assigned " & Write_Line (" M* turn off warnings for variable assigned " &
"but not read"); "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 (" n* normal warning mode (cancels -gnatws/-gnatwe)");
Write_Line (" o* turn on warnings for address clause overlay"); Write_Line (" o* turn on warnings for address clause overlay");
Write_Line (" O turn off warnings for address clause overlay"); Write_Line (" O turn off warnings for address clause overlay");
......
...@@ -2914,6 +2914,10 @@ package VMS_Data is ...@@ -2914,6 +2914,10 @@ package VMS_Data is
"-gnatwm " & "-gnatwm " &
"NOMODIFIED_UNREF " & "NOMODIFIED_UNREF " &
"-gnatwM " & "-gnatwM " &
"SUSPICIOUS_MODULUS " &
"-gnatw.m " &
"NOSUSPICIOUS_MODULUS " &
"-gnatw.M " &
"NORMAL " & "NORMAL " &
"-gnatwn " & "-gnatwn " &
"OVERLAYS " & "OVERLAYS " &
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment