From patchwork Mon Aug 6 08:27:15 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 175295 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id DFFD72C007C for ; Mon, 6 Aug 2012 18:27:46 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1344846467; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=Wy8mo0NOEcPihkt6pz0T yAiGlzc=; b=GtBHJiKzDBuDko5+KFsDEQ2RATUNyTe2METZ9VYlOhAVBC9u0b3f s1X7Z8aED9NI3FYQod5wTdB3qG2rM+r63NhnbbOv/8GUWwV/FkLewCdYG7yNC6cK O4MV7pLZHMtI8EK3nUjb2Acbsc0sKSjq1v9Tf1l/7n7DqJEKu7B4fOY= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=LyLpY0mJ7b0bnrfWW/V5c3o0ImPpGNH6T6VgKkQdDC4g5NMJnZHPa1GZnjTSRN IWLzq+bZGaD0ldzjBGQ0Og0xP6rYF18uBfuBzxpBvmgESU/YczYvqqm0ITw+dux7 T5zTZU+jxhMT+tbYc1U5QWcNTa2xMnvDn8G9wH/78gh/U=; Received: (qmail 3284 invoked by alias); 6 Aug 2012 08:27:40 -0000 Received: (qmail 3241 invoked by uid 22791); 6 Aug 2012 08:27:32 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 06 Aug 2012 08:27:16 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 574691C6D47; Mon, 6 Aug 2012 04:27:15 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 8iR1ddUmjbLe; Mon, 6 Aug 2012 04:27:15 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 327881C6D43; Mon, 6 Aug 2012 04:27:15 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 337B43FF09; Mon, 6 Aug 2012 04:27:15 -0400 (EDT) Date: Mon, 6 Aug 2012 04:27:15 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Implement extended overflow checks, step 1 Message-ID: <20120806082715.GA22314@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * 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. 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