[multiple changes]

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).
	(Overflow_Check_Type, Suppress_Record, Suppress_All): New types.
	(Suppress_Array): Extended to include switches to control extended
	overflow checking (and renamed to Suppress_Record).
	Update all uses of Suppress_Array.

2012-08-06  Thomas Quinot  <quinot@adacore.com>

	* makeutl.ads: Minor documentation fix.

2012-08-06  Thomas Quinot  <quinot@adacore.com>

	* exp_ch7.adb: Minor reformatting.

From-SVN: r190166

gcc/ada/ChangeLog

@@ -1,3 +1,22 @@
+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).
+	(Overflow_Check_Type, Suppress_Record, Suppress_All): New types.
+	(Suppress_Array): Extended to include switches to control extended
+	overflow checking (and renamed to Suppress_Record).
+	Update all uses of Suppress_Array.
+
+2012-08-06  Thomas Quinot  <quinot@adacore.com>
+
+	* makeutl.ads: Minor documentation fix.
+
+2012-08-06  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_ch7.adb: Minor reformatting.
+
 2012-08-06  Geert Bosch  <bosch@adacore.com>
 
 	* a-ngelfu.adb: Change obsolete comment that this is a non-strict

gcc/ada/checks.adb

@@ -322,7 +322,7 @@ package body Checks is
       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 @@ package body Checks is
       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 @@ package body Checks is
       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 @@ package body Checks is
       --  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 @@ package body Checks is
          end if;
       end if;
 
-      return Scope_Suppress (Discriminant_Check);
+      return Scope_Suppress.Suppress (Discriminant_Check);
    end Discriminant_Checks_Suppressed;
 
    --------------------------------
@@ -3653,7 +3653,7 @@ package body Checks is
       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 @@ package body Checks is
          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 @@ package body Checks is
       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 @@ package body Checks is
       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 @@ package body Checks is
       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 @@ package body Checks is
          end if;
       end if;
 
-      return Scope_Suppress (Range_Check);
+      return Scope_Suppress.Suppress (Range_Check);
    end Range_Checks_Suppressed;
 
    -----------------------------------------
@@ -5875,7 +5875,10 @@ package body Checks is
    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 @@ package body Checks is
       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 @@ package body Checks is
          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 @@ package body Checks is
       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;
 

gcc/ada/exp_ch4.adb

@@ -699,7 +699,7 @@ package body Exp_Ch4 is
       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

gcc/ada/exp_ch6.adb

@@ -7474,7 +7474,7 @@ package body Exp_Ch6 is
       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,

gcc/ada/exp_ch7.adb

@@ -4410,6 +4410,8 @@ package body Exp_Ch7 is
          Stmts     : List_Id;
          Temp_Id   : Entity_Id;
 
+      --  Start of processing for Process_Transient_Objects
+
       begin
          --  Examine all objects in the list First_Object .. Last_Object
 
@@ -4629,10 +4631,10 @@ package body Exp_Ch7 is
       end if;
 
       declare
-         Node_To_Wrap  : constant Node_Id := Node_To_Be_Wrapped;
+         Node_To_Wrap : constant Node_Id := Node_To_Be_Wrapped;
-         First_Obj  : Node_Id;
+         First_Obj    : Node_Id;
-         Last_Obj   : Node_Id;
+         Last_Obj     : Node_Id;
-         Target     : Node_Id;
+         Target       : Node_Id;
 
       begin
          --  If the node to be wrapped is the trigger of an asynchronous

gcc/ada/exp_util.adb

@@ -3818,20 +3818,20 @@ package body Exp_Util is
    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 @@ package body Exp_Util is
       Name_Req     : Boolean := False;
       Variable_Ref : Boolean := False)
    is
-      Loc          : constant Source_Ptr     := Sloc (Exp);
+      Loc          : constant Source_Ptr      := Sloc (Exp);
-      Exp_Type     : constant Entity_Id      := Etype (Exp);
+      Exp_Type     : constant Entity_Id       := Etype (Exp);
-      Svg_Suppress : constant Suppress_Array := Scope_Suppress;
+      Svg_Suppress : constant Suppress_Record := Scope_Suppress;
       Def_Id       : Entity_Id;
       E            : Node_Id;
       New_Exp      : Node_Id;
@@ -6705,7 +6705,7 @@ package body Exp_Util is
 
       --  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

gcc/ada/gnat1drv.adb

@@ -193,13 +193,16 @@ procedure Gnat1drv is
          --  Enable all other language checks
 
          Suppress_Options :=
-           (Access_Check      => True,
+           (Suppress                   => (Access_Check      => True,
-            Alignment_Check   => True,
+                                           Alignment_Check   => True,
-            Division_Check    => True,
+                                           Division_Check    => True,
-            Elaboration_Check => True,
+                                           Elaboration_Check => True,
-            Overflow_Check    => True,
+                                           Overflow_Check    => True,
-            others            => False);
+                                           others            => False),
-         Enable_Overflow_Checks := 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 @@ procedure Gnat1drv is
                         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 @@ procedure Gnat1drv is
       --  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 @@ procedure Gnat1drv is
          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;

gcc/ada/inline.ads

@@ -70,7 +70,7 @@ package Inline is
       --  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

gcc/ada/makeutl.ads

@@ -138,7 +138,8 @@ package Makeutl is
    --  Do nothing if Switch is an absolute path switch. If relative, fail if
    --  Parent is the empty string, otherwise prepend the path with Parent. This
    --  subprogram is only used when using project files. If For_Gnatbind is
-   --  True, gnatbind switches that are not paths (-L, -A) are left unchaned.
+   --  True, consider gnatbind specific syntax for -L (not a path, left
+   --  unchanged) and -A (path is optional, preceded with "=" if present).
    --  If Including_RTS is True, process also switches --RTS=. Do_Fail is
    --  called in case of error. Using Osint.Fail might be appropriate.
 

gcc/ada/opt.ads

@@ -1070,8 +1070,9 @@ package Opt is
 
    Overflow_Checks_Unsuppressed : Boolean := False;
    --  GNAT
-   --  Set to True if at least one occurrence of pragma Unsuppress
+   --  This flag is True if there has been at least one pragma with the
-   --  (All_Checks|Overflow_Checks) has been processed.
+   --  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 @@ package Opt is
    --  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

gcc/ada/osint.adb

@@ -1659,7 +1659,7 @@ package body Osint is
       --  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

gcc/ada/sem.adb

@@ -722,20 +722,20 @@ package body Sem is
    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 @@ package body Sem is
    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 @@ package body Sem is
    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 @@ package body Sem is
    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 @@ package body Sem is
    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 @@ package body Sem is
    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 @@ package body Sem is
       --  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;
 

gcc/ada/sem.ads

@@ -310,8 +310,8 @@ package Sem is
    --  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;
+   Scope_Suppress : Suppress_Record := Suppress_Options;
-   --  This array contains the current scope based settings of the suppress
+   --  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 @@ package Sem is
       --  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;

gcc/ada/sem_attr.adb

@@ -5880,7 +5880,7 @@ package body Sem_Attr is
             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;

gcc/ada/sem_ch10.adb

@@ -1964,7 +1964,7 @@ package body Sem_Ch10 is
       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;

gcc/ada/sem_prag.adb

@@ -5485,9 +5485,9 @@ package body Sem_Prag is
                --  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 @@ package body Sem_Prag is
          --  user code: we want to generate checks for analysis purposes, as
          --  set respectively by -gnatC and -gnatd.F
 
-         if (CodePeer_Mode or Alfa_Mode)
+         if (CodePeer_Mode or Alfa_Mode) and then Comes_From_Source (N) then
-           and then Comes_From_Source (N)
-         then
             return;
          end if;
 
@@ -5666,10 +5664,17 @@ package body Sem_Prag is
               ("argument of pragma% is not valid check name", Arg1);
          end if;
 
-         if not Suppress_Case
+         --  Special processing for overflow check case
-           and then (C = All_Checks or else C = Overflow_Check)
+
-         then
+         if C = All_Checks or else C = Overflow_Check then
-            Opt.Overflow_Checks_Unsuppressed := True;
+            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 @@ package body Sem_Prag is
                --  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 @@ package body Sem_Prag is
               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

gcc/ada/sem_res.adb

@@ -334,21 +334,20 @@ package body Sem_Res is
    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 @@ package body Sem_Res is
    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
+      if Current_Scope /= Scop and then Scope_Is_Transient then
-        and then Scope_Is_Transient
-      then
          Scope_Stack.Table (Scope_Stack.Last).Save_Scope_Suppress :=
            Scope_Suppress;
       end if;
@@ -2904,20 +2900,20 @@ package body Sem_Res is
    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;

gcc/ada/switch-c.adb

@@ -443,7 +443,8 @@ package body Switch.C is
                   --  -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 @@ package body Switch.C is
 
             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 @@ package body Switch.C is
                   --  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;

gcc/ada/types.ads

@@ -646,9 +646,9 @@ package Types is
       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 @@ package Types is
    --    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 --
    -----------------------------------