diff mbox

[Ada] Implement extended overflow checks, step 1

Message ID 20120806082715.GA22314@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Aug. 6, 2012, 8:27 a.m. UTC 
This patch extends the type Suppress_Array in types.ads to include
the switches to control extended overflow checking. The new type is
called Suppress_Record, and all uses elsewhere of Suppress_Array
are changed to be Suppress_Record. So far, the only settings for
the new overflow checking modes are Suppress and Check_All, which
are equivalent to the previous Suppress and check modes, so there
is no functional change so far, so no test is required.

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

2012-08-06  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb, switch-c.adb, inline.ads, sem_ch10.adb, types.ads,
	checks.adb, sem_prag.adb, sem.adb, sem.ads, sem_res.adb, sem_attr.adb,
	gnat1drv.adb, exp_ch4.adb, exp_ch6.adb, opt.ads, osint.adb: Implement
	extended overflow checks (step 1).
	(Suppress_Array): extended to include switches to control extended
	overflow checking.
	Update all uses of Suppress_Array.
diff mbox

Patch

Index: exp_util.adb
===================================================================
--- exp_util.adb	(revision 190155)
+++ exp_util.adb	(working copy)
@@ -3818,20 +3818,20 @@ 
    begin
       if Suppress = All_Checks then
          declare
-            Svg : constant Suppress_Array := Scope_Suppress;
+            Svg : constant Suppress_Record := Scope_Suppress;
          begin
-            Scope_Suppress := (others => True);
+            Scope_Suppress := Suppress_All;
             Insert_Actions (Assoc_Node, Ins_Actions);
             Scope_Suppress := Svg;
          end;
 
       else
          declare
-            Svg : constant Boolean := Scope_Suppress (Suppress);
+            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
          begin
-            Scope_Suppress (Suppress) := True;
+            Scope_Suppress.Suppress (Suppress) := True;
             Insert_Actions (Assoc_Node, Ins_Actions);
-            Scope_Suppress (Suppress) := Svg;
+            Scope_Suppress.Suppress (Suppress) := Svg;
          end;
       end if;
    end Insert_Actions;
@@ -6272,9 +6272,9 @@ 
       Name_Req     : Boolean := False;
       Variable_Ref : Boolean := False)
    is
-      Loc          : constant Source_Ptr     := Sloc (Exp);
-      Exp_Type     : constant Entity_Id      := Etype (Exp);
-      Svg_Suppress : constant Suppress_Array := Scope_Suppress;
+      Loc          : constant Source_Ptr      := Sloc (Exp);
+      Exp_Type     : constant Entity_Id       := Etype (Exp);
+      Svg_Suppress : constant Suppress_Record := Scope_Suppress;
       Def_Id       : Entity_Id;
       E            : Node_Id;
       New_Exp      : Node_Id;
@@ -6705,7 +6705,7 @@ 
 
       --  All this must not have any checks
 
-      Scope_Suppress := (others => True);
+      Scope_Suppress := Suppress_All;
 
       --  If it is a scalar type and we need to capture the value, just make
       --  a copy. Likewise for a function call, an attribute reference, an
Index: switch-c.adb
===================================================================
--- switch-c.adb	(revision 190155)
+++ switch-c.adb	(working copy)
@@ -443,7 +443,8 @@ 
                   --  -gnated switch (disable atomic synchronization)
 
                   when 'd' =>
-                     Suppress_Options (Atomic_Synchronization) := True;
+                     Suppress_Options.Suppress (Atomic_Synchronization) :=
+                       True;
 
                   --  -gnateD switch (preprocessing symbol definition)
 
@@ -754,7 +755,9 @@ 
 
             when 'o' =>
                Ptr := Ptr + 1;
-               Suppress_Options (Overflow_Check) := False;
+               Suppress_Options.Suppress (Overflow_Check) := False;
+               Suppress_Options.Overflow_Checks_General := Check_All;
+               Suppress_Options.Overflow_Checks_Assertions := Check_All;
                Opt.Enable_Overflow_Checks := True;
 
             --  Processing for O switch
@@ -782,12 +785,16 @@ 
                   --  exclude Atomic_Synchronization, since this is not a real
                   --  check.
 
-                  for J in Suppress_Options'Range loop
+                  for J in Suppress_Options.Suppress'Range loop
                      if J /= Elaboration_Check
-                       and then J /= Atomic_Synchronization
+                          and then
+                        J /= Atomic_Synchronization
                      then
-                        Suppress_Options (J) := True;
+                        Suppress_Options.Suppress (J) := True;
                      end if;
+
+                     Suppress_Options.Overflow_Checks_General    := Suppress;
+                     Suppress_Options.Overflow_Checks_Assertions := Suppress;
                   end loop;
 
                   Validity_Checks_On         := False;
Index: inline.ads
===================================================================
--- inline.ads	(revision 190155)
+++ inline.ads	(working copy)
@@ -70,7 +70,7 @@ 
       --  be restored when compiling the body, to insure that internal enti-
       --  ties use the same counter and are unique over spec and body.
 
-      Scope_Suppress           : Suppress_Array;
+      Scope_Suppress           : Suppress_Record;
       Local_Suppress_Stack_Top : Suppress_Stack_Entry_Ptr;
       --  Save suppress information at the point of instantiation. Used to
       --  properly inherit check status active at this point (see RM 11.5
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb	(revision 190155)
+++ sem_ch10.adb	(working copy)
@@ -1964,7 +1964,7 @@ 
       Num_Scopes      : Int := 0;
       Use_Clauses     : array (1 .. Scope_Stack.Last) of Node_Id;
       Enclosing_Child : Entity_Id := Empty;
-      Svg             : constant Suppress_Array := Scope_Suppress;
+      Svg             : constant Suppress_Record := Scope_Suppress;
 
       Save_Cunit_Restrictions : constant Save_Cunit_Boolean_Restrictions :=
                                   Cunit_Boolean_Restrictions_Save;
Index: types.ads
===================================================================
--- types.ads	(revision 190155)
+++ types.ads	(working copy)
@@ -646,9 +646,9 @@ 
       TS      : out Time_Stamp_Type);
    --  Given the components of a time stamp, initialize the value
 
-   -----------------------------------------------
-   -- Types used for Pragma Suppress Management --
-   -----------------------------------------------
+   -------------------------------------
+   -- Types used for Check Management --
+   -------------------------------------
 
    type Check_Id is new Nat;
    --  Type used to represent a check id
@@ -703,6 +703,56 @@ 
    --    4.  Add a new Do_xxx_Check flag to Sinfo (if required)
    --    5.  Add appropriate checks for the new test
 
+   --  The following provides precise details on the mode used to check
+   --  intermediate overflows in expressions for signed integer arithmetic.
+
+   type Overflow_Check_Type is
+     (Suppress,
+      --  Intermediate overflow suppressed. If an arithmetic operation creates
+      --  an overflow, no exception is raised, and the program is erroneous.
+
+      Check_All,
+      --  All intermediate operations are checked. If the result of any
+      --  arithmetic operation gives a result outside the range of the base
+      --  type, then a Constraint_Error exception is raised.
+
+      Minimize,
+      --  Where appropriate, arithmetic operations are performed with an
+      --  extended range, using Long_Long_Integer if necessary. As long as
+      --  the result fits in this extended range, then no exception is raised
+      --  and computation continues with the extended result. The final value
+      --  of an expression must fit in the base type of the whole expression.
+      --  If an intermediate result is outside the range of Long_Long_Integer
+      --  then a Constraint_Error exception is raised.
+
+      Eliminate);
+      --  In this mode arbitrary precision arithmetic is used as needed to
+      --  ensure that it is impossible for intermediate arithmetic to cause
+      --  an overflow. Again the final value of an expression must fit in
+      --  the base type of the whole expression.
+
+   --  The following structure captures the state of check suppression or
+   --  activation at a particular point in the program execution.
+
+   type Suppress_Record is record
+      Suppress : Suppress_Array;
+      --  Indicates suppression status of each possible check
+
+      Overflow_Checks_General : Overflow_Check_Type;
+      --  This field is relevant only if Suppress (Overflow_Check) is False.
+      --  It indicates the mode of overflow checking to be applied to general
+      --  expressions outside assertions.
+
+      Overflow_Checks_Assertions : Overflow_Check_Type;
+      --  This field is relevant only if Suppress (Overflow_Check) is False.
+      --  It indicates the mode of overflow checking to be applied to any
+      --  expressions occuring inside assertions.
+   end record;
+
+   Suppress_All : constant Suppress_Record :=
+                    ((others => True), Suppress, Suppress);
+   --  Constant used to initialize Suppress_Record value to all suppressed.
+
    -----------------------------------
    -- Global Exception Declarations --
    -----------------------------------
Index: checks.adb
===================================================================
--- checks.adb	(revision 190156)
+++ checks.adb	(working copy)
@@ -322,7 +322,7 @@ 
       if Present (E) and then Checks_May_Be_Suppressed (E) then
          return Is_Check_Suppressed (E, Access_Check);
       else
-         return Scope_Suppress (Access_Check);
+         return Scope_Suppress.Suppress (Access_Check);
       end if;
    end Access_Checks_Suppressed;
 
@@ -335,7 +335,7 @@ 
       if Present (E) and then Checks_May_Be_Suppressed (E) then
          return Is_Check_Suppressed (E, Accessibility_Check);
       else
-         return Scope_Suppress (Accessibility_Check);
+         return Scope_Suppress.Suppress (Accessibility_Check);
       end if;
    end Accessibility_Checks_Suppressed;
 
@@ -378,7 +378,7 @@ 
       if Present (E) and then Checks_May_Be_Suppressed (E) then
          return Is_Check_Suppressed (E, Alignment_Check);
       else
-         return Scope_Suppress (Alignment_Check);
+         return Scope_Suppress.Suppress (Alignment_Check);
       end if;
    end Alignment_Checks_Suppressed;
 
@@ -2616,7 +2616,7 @@ 
       --  Otherwise result depends on current scope setting
 
       else
-         return Scope_Suppress (Atomic_Synchronization);
+         return Scope_Suppress.Suppress (Atomic_Synchronization);
       end if;
    end Atomic_Synchronization_Disabled;
 
@@ -3641,7 +3641,7 @@ 
          end if;
       end if;
 
-      return Scope_Suppress (Discriminant_Check);
+      return Scope_Suppress.Suppress (Discriminant_Check);
    end Discriminant_Checks_Suppressed;
 
    --------------------------------
@@ -3653,7 +3653,7 @@ 
       if Present (E) and then Checks_May_Be_Suppressed (E) then
          return Is_Check_Suppressed (E, Division_Check);
       else
-         return Scope_Suppress (Division_Check);
+         return Scope_Suppress.Suppress (Division_Check);
       end if;
    end Division_Checks_Suppressed;
 
@@ -3682,10 +3682,10 @@ 
          end if;
       end if;
 
-      if Scope_Suppress (Elaboration_Check) then
+      if Scope_Suppress.Suppress (Elaboration_Check) then
          return True;
       elsif Dynamic_Elaboration_Checks then
-         return Scope_Suppress (All_Checks);
+         return Scope_Suppress.Suppress (All_Checks);
       else
          return False;
       end if;
@@ -5305,7 +5305,7 @@ 
       if Present (E) and then Checks_May_Be_Suppressed (E) then
          return Is_Check_Suppressed (E, Index_Check);
       else
-         return Scope_Suppress (Index_Check);
+         return Scope_Suppress.Suppress (Index_Check);
       end if;
    end Index_Checks_Suppressed;
 
@@ -5821,7 +5821,7 @@ 
       if Present (E) and then Checks_May_Be_Suppressed (E) then
          return Is_Check_Suppressed (E, Length_Check);
       else
-         return Scope_Suppress (Length_Check);
+         return Scope_Suppress.Suppress (Length_Check);
       end if;
    end Length_Checks_Suppressed;
 
@@ -5834,7 +5834,7 @@ 
       if Present (E) and then Checks_May_Be_Suppressed (E) then
          return Is_Check_Suppressed (E, Overflow_Check);
       else
-         return Scope_Suppress (Overflow_Check);
+         return Scope_Suppress.Suppress (Overflow_Check);
       end if;
    end Overflow_Checks_Suppressed;
 
@@ -5858,7 +5858,7 @@ 
          end if;
       end if;
 
-      return Scope_Suppress (Range_Check);
+      return Scope_Suppress.Suppress (Range_Check);
    end Range_Checks_Suppressed;
 
    -----------------------------------------
@@ -5875,7 +5875,10 @@ 
    begin
       --  Immediate return if scope checks suppressed for either check
 
-      if Scope_Suppress (Range_Check) or Scope_Suppress (Validity_Check) then
+      if Scope_Suppress.Suppress (Range_Check)
+           or
+         Scope_Suppress.Suppress (Validity_Check)
+      then
          return True;
       end if;
 
@@ -7356,7 +7359,7 @@ 
       if Present (E) and then Checks_May_Be_Suppressed (E) then
          return Is_Check_Suppressed (E, Storage_Check);
       else
-         return Scope_Suppress (Storage_Check);
+         return Scope_Suppress.Suppress (Storage_Check);
       end if;
    end Storage_Checks_Suppressed;
 
@@ -7372,7 +7375,7 @@ 
          return Is_Check_Suppressed (E, Tag_Check);
       end if;
 
-      return Scope_Suppress (Tag_Check);
+      return Scope_Suppress.Suppress (Tag_Check);
    end Tag_Checks_Suppressed;
 
    --------------------------
@@ -7398,7 +7401,7 @@ 
       if Present (E) and then Checks_May_Be_Suppressed (E) then
          return Is_Check_Suppressed (E, Validity_Check);
       else
-         return Scope_Suppress (Validity_Check);
+         return Scope_Suppress.Suppress (Validity_Check);
       end if;
    end Validity_Checks_Suppressed;
 
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 190155)
+++ sem_prag.adb	(working copy)
@@ -5485,9 +5485,9 @@ 
                --  affected by this processing).
 
                if R_Id = No_Exceptions and then not Warn then
-                  for J in Scope_Suppress'Range loop
+                  for J in Scope_Suppress.Suppress'Range loop
                      if J /= Atomic_Synchronization then
-                        Scope_Suppress (J) := True;
+                        Scope_Suppress.Suppress (J) := True;
                      end if;
                   end loop;
                end if;
@@ -5641,9 +5641,7 @@ 
          --  user code: we want to generate checks for analysis purposes, as
          --  set respectively by -gnatC and -gnatd.F
 
-         if (CodePeer_Mode or Alfa_Mode)
-           and then Comes_From_Source (N)
-         then
+         if (CodePeer_Mode or Alfa_Mode) and then Comes_From_Source (N) then
             return;
          end if;
 
@@ -5666,10 +5664,17 @@ 
               ("argument of pragma% is not valid check name", Arg1);
          end if;
 
-         if not Suppress_Case
-           and then (C = All_Checks or else C = Overflow_Check)
-         then
-            Opt.Overflow_Checks_Unsuppressed := True;
+         --  Special processing for overflow check case
+
+         if C = All_Checks or else C = Overflow_Check then
+            if Suppress_Case then
+               Scope_Suppress.Overflow_Checks_General    := Suppress;
+               Scope_Suppress.Overflow_Checks_Assertions := Suppress;
+            else
+               Scope_Suppress.Overflow_Checks_General    := Check_All;
+               Scope_Suppress.Overflow_Checks_Assertions := Check_All;
+               Opt.Overflow_Checks_Unsuppressed := True;
+            end if;
          end if;
 
          if Arg_Count = 1 then
@@ -5687,11 +5692,12 @@ 
                --  Atomic_Synchronization is also not affected, since this is
                --  not a real check.
 
-               for J in Scope_Suppress'Range loop
+               for J in Scope_Suppress.Suppress'Range loop
                   if J /= Elaboration_Check
-                    and then J /= Atomic_Synchronization
+                       and then
+                     J /= Atomic_Synchronization
                   then
-                     Scope_Suppress (J) := Suppress_Case;
+                     Scope_Suppress.Suppress (J) := Suppress_Case;
                   end if;
                end loop;
 
@@ -5704,7 +5710,7 @@ 
               and then (not Comes_From_Source (N)
                          or else C /= Atomic_Synchronization)
             then
-               Scope_Suppress (C) := Suppress_Case;
+               Scope_Suppress.Suppress (C) := Suppress_Case;
             end if;
 
             --  Also make an entry in the Local_Entity_Suppress table
Index: sem.adb
===================================================================
--- sem.adb	(revision 190155)
+++ sem.adb	(working copy)
@@ -722,20 +722,20 @@ 
    begin
       if Suppress = All_Checks then
          declare
-            Svg : constant Suppress_Array := Scope_Suppress;
+            Svg : constant Suppress_Record := Scope_Suppress;
          begin
-            Scope_Suppress := (others => True);
+            Scope_Suppress := Suppress_All;
             Analyze (N);
             Scope_Suppress := Svg;
          end;
 
       else
          declare
-            Svg : constant Boolean := Scope_Suppress (Suppress);
+            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
          begin
-            Scope_Suppress (Suppress) := True;
+            Scope_Suppress.Suppress (Suppress) := True;
             Analyze (N);
-            Scope_Suppress (Suppress) := Svg;
+            Scope_Suppress.Suppress (Suppress) := Svg;
          end;
       end if;
    end Analyze;
@@ -761,20 +761,20 @@ 
    begin
       if Suppress = All_Checks then
          declare
-            Svg : constant Suppress_Array := Scope_Suppress;
+            Svg : constant Suppress_Record := Scope_Suppress;
          begin
-            Scope_Suppress := (others => True);
+            Scope_Suppress := Suppress_All;
             Analyze_List (L);
             Scope_Suppress := Svg;
          end;
 
       else
          declare
-            Svg : constant Boolean := Scope_Suppress (Suppress);
+            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
          begin
-            Scope_Suppress (Suppress) := True;
+            Scope_Suppress.Suppress (Suppress) := True;
             Analyze_List (L);
-            Scope_Suppress (Suppress) := Svg;
+            Scope_Suppress.Suppress (Suppress) := Svg;
          end;
       end if;
    end Analyze_List;
@@ -1022,20 +1022,20 @@ 
    begin
       if Suppress = All_Checks then
          declare
-            Svg : constant Suppress_Array := Scope_Suppress;
+            Svg : constant Suppress_Record := Scope_Suppress;
          begin
-            Scope_Suppress := (others => True);
+            Scope_Suppress := Suppress_All;
             Insert_After_And_Analyze (N, M);
             Scope_Suppress := Svg;
          end;
 
       else
          declare
-            Svg : constant Boolean := Scope_Suppress (Suppress);
+            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
          begin
-            Scope_Suppress (Suppress) := True;
+            Scope_Suppress.Suppress (Suppress) := True;
             Insert_After_And_Analyze (N, M);
-            Scope_Suppress (Suppress) := Svg;
+            Scope_Suppress.Suppress (Suppress) := Svg;
          end;
       end if;
    end Insert_After_And_Analyze;
@@ -1082,20 +1082,20 @@ 
    begin
       if Suppress = All_Checks then
          declare
-            Svg : constant Suppress_Array := Scope_Suppress;
+            Svg : constant Suppress_Record := Scope_Suppress;
          begin
-            Scope_Suppress := (others => True);
+            Scope_Suppress := Suppress_All;
             Insert_Before_And_Analyze (N, M);
             Scope_Suppress := Svg;
          end;
 
       else
          declare
-            Svg : constant Boolean := Scope_Suppress (Suppress);
+            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
          begin
-            Scope_Suppress (Suppress) := True;
+            Scope_Suppress.Suppress (Suppress) := True;
             Insert_Before_And_Analyze (N, M);
-            Scope_Suppress (Suppress) := Svg;
+            Scope_Suppress.Suppress (Suppress) := Svg;
          end;
       end if;
    end Insert_Before_And_Analyze;
@@ -1141,20 +1141,20 @@ 
    begin
       if Suppress = All_Checks then
          declare
-            Svg : constant Suppress_Array := Scope_Suppress;
+            Svg : constant Suppress_Record := Scope_Suppress;
          begin
-            Scope_Suppress := (others => True);
+            Scope_Suppress := Suppress_All;
             Insert_List_After_And_Analyze (N, L);
             Scope_Suppress := Svg;
          end;
 
       else
          declare
-            Svg : constant Boolean := Scope_Suppress (Suppress);
+            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
          begin
-            Scope_Suppress (Suppress) := True;
+            Scope_Suppress.Suppress (Suppress) := True;
             Insert_List_After_And_Analyze (N, L);
-            Scope_Suppress (Suppress) := Svg;
+            Scope_Suppress.Suppress (Suppress) := Svg;
          end;
       end if;
    end Insert_List_After_And_Analyze;
@@ -1199,20 +1199,20 @@ 
    begin
       if Suppress = All_Checks then
          declare
-            Svg : constant Suppress_Array := Scope_Suppress;
+            Svg : constant Suppress_Record := Scope_Suppress;
          begin
-            Scope_Suppress := (others => True);
+            Scope_Suppress := Suppress_All;
             Insert_List_Before_And_Analyze (N, L);
             Scope_Suppress := Svg;
          end;
 
       else
          declare
-            Svg : constant Boolean := Scope_Suppress (Suppress);
+            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
          begin
-            Scope_Suppress (Suppress) := True;
+            Scope_Suppress.Suppress (Suppress) := True;
             Insert_List_Before_And_Analyze (N, L);
-            Scope_Suppress (Suppress) := Svg;
+            Scope_Suppress.Suppress (Suppress) := Svg;
          end;
       end if;
    end Insert_List_Before_And_Analyze;
@@ -1264,9 +1264,9 @@ 
       --  the All_Checks flag.
 
       if C in Predefined_Check_Id then
-         return Scope_Suppress (C);
+         return Scope_Suppress.Suppress (C);
       else
-         return Scope_Suppress (All_Checks);
+         return Scope_Suppress.Suppress (All_Checks);
       end if;
    end Is_Check_Suppressed;
 
Index: sem.ads
===================================================================
--- sem.ads	(revision 190155)
+++ sem.ads	(working copy)
@@ -310,8 +310,8 @@ 
    --  that are applicable to all entities. A similar search is needed for any
    --  non-predefined check even if no specific entity is involved.
 
-   Scope_Suppress : Suppress_Array := Suppress_Options;
-   --  This array contains the current scope based settings of the suppress
+   Scope_Suppress : Suppress_Record := Suppress_Options;
+   --  This variable contains the current scope based settings of the suppress
    --  switches. It is initialized from the options as shown, and then modified
    --  by pragma Suppress. On entry to each scope, the current setting is saved
    --  the scope stack, and then restored on exit from the scope. This record
@@ -449,7 +449,7 @@ 
       --  Pointer to name of last subprogram body in this scope. Used for
       --  testing proper alpha ordering of subprogram bodies in scope.
 
-      Save_Scope_Suppress : Suppress_Array;
+      Save_Scope_Suppress : Suppress_Record;
       --  Save contents of Scope_Suppress on entry
 
       Save_Local_Suppress_Stack_Top : Suppress_Stack_Entry_Ptr;
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 190155)
+++ sem_res.adb	(working copy)
@@ -334,21 +334,20 @@ 
    begin
       if Suppress = All_Checks then
          declare
-            Svg : constant Suppress_Array := Scope_Suppress;
+            Svg : constant Suppress_Record := Scope_Suppress;
          begin
-            Scope_Suppress := (others => True);
+            Scope_Suppress := Suppress_All;
             Analyze_And_Resolve (N, Typ);
             Scope_Suppress := Svg;
          end;
 
       else
          declare
-            Svg : constant Boolean := Scope_Suppress (Suppress);
-
+            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
          begin
-            Scope_Suppress (Suppress) := True;
+            Scope_Suppress.Suppress (Suppress) := True;
             Analyze_And_Resolve (N, Typ);
-            Scope_Suppress (Suppress) := Svg;
+            Scope_Suppress.Suppress (Suppress) := Svg;
          end;
       end if;
 
@@ -375,27 +374,24 @@ 
    begin
       if Suppress = All_Checks then
          declare
-            Svg : constant Suppress_Array := Scope_Suppress;
+            Svg : constant Suppress_Record := Scope_Suppress;
          begin
-            Scope_Suppress := (others => True);
+            Scope_Suppress := Suppress_All;
             Analyze_And_Resolve (N);
             Scope_Suppress := Svg;
          end;
 
       else
          declare
-            Svg : constant Boolean := Scope_Suppress (Suppress);
-
+            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
          begin
-            Scope_Suppress (Suppress) := True;
+            Scope_Suppress.Suppress (Suppress) := True;
             Analyze_And_Resolve (N);
-            Scope_Suppress (Suppress) := Svg;
+            Scope_Suppress.Suppress (Suppress) := Svg;
          end;
       end if;
 
-      if Current_Scope /= Scop
-        and then Scope_Is_Transient
-      then
+      if Current_Scope /= Scop and then Scope_Is_Transient then
          Scope_Stack.Table (Scope_Stack.Last).Save_Scope_Suppress :=
            Scope_Suppress;
       end if;
@@ -2904,20 +2900,20 @@ 
    begin
       if Suppress = All_Checks then
          declare
-            Svg : constant Suppress_Array := Scope_Suppress;
+            Svg : constant Suppress_Record := Scope_Suppress;
          begin
-            Scope_Suppress := (others => True);
+            Scope_Suppress := Suppress_All;
             Resolve (N, Typ);
             Scope_Suppress := Svg;
          end;
 
       else
          declare
-            Svg : constant Boolean := Scope_Suppress (Suppress);
+            Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
          begin
-            Scope_Suppress (Suppress) := True;
+            Scope_Suppress.Suppress (Suppress) := True;
             Resolve (N, Typ);
-            Scope_Suppress (Suppress) := Svg;
+            Scope_Suppress.Suppress (Suppress) := Svg;
          end;
       end if;
    end Resolve;
Index: sem_attr.adb
===================================================================
--- sem_attr.adb	(revision 190163)
+++ sem_attr.adb	(working copy)
@@ -5880,7 +5880,7 @@ 
             begin
                if No (E1) then
                   if C in Predefined_Check_Id then
-                     R := Scope_Suppress (C);
+                     R := Scope_Suppress.Suppress (C);
                   else
                      R := Is_Check_Suppressed (Empty, C);
                   end if;
Index: gnat1drv.adb
===================================================================
--- gnat1drv.adb	(revision 190155)
+++ gnat1drv.adb	(working copy)
@@ -193,13 +193,16 @@ 
          --  Enable all other language checks
 
          Suppress_Options :=
-           (Access_Check      => True,
-            Alignment_Check   => True,
-            Division_Check    => True,
-            Elaboration_Check => True,
-            Overflow_Check    => True,
-            others            => False);
-         Enable_Overflow_Checks := False;
+           (Suppress                   => (Access_Check      => True,
+                                           Alignment_Check   => True,
+                                           Division_Check    => True,
+                                           Elaboration_Check => True,
+                                           Overflow_Check    => True,
+                                           others            => False),
+            Overflow_Checks_General    => Suppress,
+            Overflow_Checks_Assertions => Suppress);
+
+         Enable_Overflow_Checks     := False;
          Dynamic_Elaboration_Checks := False;
 
          --  Kill debug of generated code, since it messes up sloc values
@@ -339,9 +342,11 @@ 
                         and
                        Targparm.Backend_Overflow_Checks_On_Target))
       then
-         Suppress_Options (Overflow_Check) := False;
+         Suppress_Options.Suppress (Overflow_Check) := False;
       else
-         Suppress_Options (Overflow_Check) := True;
+         Suppress_Options.Suppress (Overflow_Check)  := True;
+         Suppress_Options.Overflow_Checks_General    := Check_All;
+         Suppress_Options.Overflow_Checks_Assertions := Check_All;
       end if;
 
       --  Set default for atomic synchronization. As this synchronization
@@ -349,7 +354,8 @@ 
       --  on some targets, an optional target parameter can turn the option
       --  off. Note Atomic Synchronization is implemented as check.
 
-      Suppress_Options (Atomic_Synchronization) := not Atomic_Sync_Default;
+      Suppress_Options.Suppress (Atomic_Synchronization) :=
+        not Atomic_Sync_Default;
 
       --  Set switch indicating if we can use N_Expression_With_Actions
 
@@ -426,12 +432,12 @@ 
          Restrict.Restrictions.Set (No_Initialize_Scalars) := True;
 
          --  Suppress all language checks since they are handled implicitly by
-         --  the formal verification backend.
+         --    the formal verification backend.
          --  Turn off dynamic elaboration checks.
          --  Turn off alignment checks.
          --  Turn off validity checking.
 
-         Suppress_Options := (others => True);
+         Suppress_Options := Suppress_All;
          Enable_Overflow_Checks := False;
          Dynamic_Elaboration_Checks := False;
          Reset_Validity_Check_Options;
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 190155)
+++ exp_ch4.adb	(working copy)
@@ -699,7 +699,7 @@ 
       begin
          if Ada_Version >= Ada_2005
            and then Is_Class_Wide_Type (DesigT)
-           and then not Scope_Suppress (Accessibility_Check)
+           and then not Scope_Suppress.Suppress (Accessibility_Check)
            and then
              (Type_Access_Level (Etype (Exp)) > Type_Access_Level (PtrT)
                or else
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb	(revision 190155)
+++ exp_ch6.adb	(working copy)
@@ -7474,7 +7474,7 @@ 
       elsif Ada_Version >= Ada_2005
         and then Tagged_Type_Expansion
         and then Is_Class_Wide_Type (R_Type)
-        and then not Scope_Suppress (Accessibility_Check)
+        and then not Scope_Suppress.Suppress (Accessibility_Check)
         and then
           (Is_Class_Wide_Type (Etype (Exp))
             or else Nkind_In (Exp, N_Type_Conversion,
Index: opt.ads
===================================================================
--- opt.ads	(revision 190155)
+++ opt.ads	(working copy)
@@ -1070,8 +1070,9 @@ 
 
    Overflow_Checks_Unsuppressed : Boolean := False;
    --  GNAT
-   --  Set to True if at least one occurrence of pragma Unsuppress
-   --  (All_Checks|Overflow_Checks) has been processed.
+   --  This flag is True if there has been at least one pragma with the
+   --  effect of unsuppressing overflow checks, meaning that a more careful
+   --  check of the current mode is required.
 
    Persistent_BSS_Mode : Boolean := False;
    --  GNAT
@@ -1249,7 +1250,7 @@ 
    --  GNAT
    --  Set to True if -gnatp (suppress all checks) switch present.
 
-   Suppress_Options : Suppress_Array;
+   Suppress_Options : Suppress_Record;
    --  GNAT
    --  Flags set True to suppress corresponding check, i.e. add an implicit
    --  pragma Suppress at the outer level of each unit compiled. Note that
Index: osint.adb
===================================================================
--- osint.adb	(revision 190158)
+++ osint.adb	(working copy)
@@ -1659,7 +1659,7 @@ 
       --  be reset later (turning some on if -gnato is not specified, and
       --  turning all of them on if -gnatp is specified).
 
-      Suppress_Options := (others => False);
+      Suppress_Options := ((others => False), Check_All, Check_All);
 
       --  Reserve the first slot in the search paths table. This is the
       --  directory of the main source file or main library file and is filled