diff options
Diffstat (limited to 'gcc/ada/checks.adb')
| -rw-r--r-- | gcc/ada/checks.adb | 315 |
1 files changed, 176 insertions, 139 deletions
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 406d292f09e..b0262dba815 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -194,18 +194,19 @@ package body Checks is -- Local Subprograms -- ----------------------- - procedure Apply_Arithmetic_Overflow_Checked_Suppressed (N : Node_Id); + procedure Apply_Arithmetic_Overflow_Strict (N : Node_Id); -- Used to apply arithmetic overflow checks for all cases except operators -- on signed arithmetic types in MINIMIZED/ELIMINATED case (for which we - -- call Apply_Arithmetic_Overflow_Minimized_Eliminated below). N is always - -- a signed integer arithmetic operator (if and case expressions are not - -- included for this case). + -- call Apply_Arithmetic_Overflow_Minimized_Eliminated below). N can be a + -- signed integer arithmetic operator (but not an if or case expression). + -- It is also called for types other than signed integers. procedure Apply_Arithmetic_Overflow_Minimized_Eliminated (Op : Node_Id); -- Used to apply arithmetic overflow checks for the case where the overflow - -- checking mode is MINIMIZED or ELIMINATED (and the Do_Overflow_Check flag - -- is known to be set) and we have a signed integer arithmetic op (which - -- includes the case of if and case expressions). + -- checking mode is MINIMIZED or ELIMINATED and we have a signed integer + -- arithmetic op (which includes the case of if and case expressions). Note + -- that Do_Overflow_Check may or may not be set for node Op. In these modes + -- we have work to do even if overflow checking is suppressed. procedure Apply_Division_Check (N : Node_Id; @@ -766,14 +767,12 @@ package body Checks is begin -- Use old routine in almost all cases (the only case we are treating -- specially is the case of a signed integer arithmetic op with the - -- Do_Overflow_Check flag set on the node, and the overflow checking - -- mode is MINIMIZED or ELIMINATED). + -- overflow checking mode set to MINIMIZED or ELIMINATED). - if Overflow_Check_Mode (Etype (N)) not in Minimized_Or_Eliminated - or else not Do_Overflow_Check (N) + if Overflow_Check_Mode = Strict or else not Is_Signed_Integer_Arithmetic_Op (N) then - Apply_Arithmetic_Overflow_Checked_Suppressed (N); + Apply_Arithmetic_Overflow_Strict (N); -- Otherwise use the new routine for the case of a signed integer -- arithmetic op, with Do_Overflow_Check set to True, and the checking @@ -784,9 +783,9 @@ package body Checks is end if; end Apply_Arithmetic_Overflow_Check; - -------------------------------------------------- - -- Apply_Arithmetic_Overflow_Checked_Suppressed -- - -------------------------------------------------- + -------------------------------------- + -- Apply_Arithmetic_Overflow_Strict -- + -------------------------------------- -- This routine is called only if the type is an integer type, and a -- software arithmetic overflow check may be needed for op (add, subtract, @@ -795,21 +794,28 @@ package body Checks is -- operation into a more complex sequence of tests that ensures that -- overflow is properly caught. - -- This is used in SUPPRESSED/CHECKED modes. It is identical to the - -- code for these cases before the big overflow earthquake, thus ensuring - -- that in these modes we have compatible behavior (and reliability) to - -- what was there before. It is also called for types other than signed - -- integers, and if the Do_Overflow_Check flag is off. + -- This is used in CHECKED modes. It is identical to the code for this + -- cases before the big overflow earthquake, thus ensuring that in this + -- modes we have compatible behavior (and reliability) to what was there + -- before. It is also called for types other than signed integers, and if + -- the Do_Overflow_Check flag is off. -- Note: we also call this routine if we decide in the MINIMIZED case -- to give up and just generate an overflow check without any fuss. - procedure Apply_Arithmetic_Overflow_Checked_Suppressed (N : Node_Id) is + procedure Apply_Arithmetic_Overflow_Strict (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); Typ : constant Entity_Id := Etype (N); Rtyp : constant Entity_Id := Root_Type (Typ); begin + -- Nothing to do if Do_Overflow_Check not set or overflow checks + -- suppressed. + + if not Do_Overflow_Check (N) then + return; + end if; + -- An interesting special case. If the arithmetic operation appears as -- the operand of a type conversion: @@ -1067,7 +1073,7 @@ package body Checks is when RE_Not_Available => return; end; - end Apply_Arithmetic_Overflow_Checked_Suppressed; + end Apply_Arithmetic_Overflow_Strict; ---------------------------------------------------- -- Apply_Arithmetic_Overflow_Minimized_Eliminated -- @@ -1075,7 +1081,6 @@ package body Checks is procedure Apply_Arithmetic_Overflow_Minimized_Eliminated (Op : Node_Id) is pragma Assert (Is_Signed_Integer_Arithmetic_Op (Op)); - pragma Assert (Do_Overflow_Check (Op)); Loc : constant Source_Ptr := Sloc (Op); P : constant Node_Id := Parent (Op); @@ -1086,8 +1091,7 @@ package body Checks is Result_Type : constant Entity_Id := Etype (Op); -- Original result type - Check_Mode : constant Overflow_Check_Type := - Overflow_Check_Mode (Etype (Op)); + Check_Mode : constant Overflow_Check_Type := Overflow_Check_Mode; pragma Assert (Check_Mode in Minimized_Or_Eliminated); Lo, Hi : Uint; @@ -1102,7 +1106,7 @@ package body Checks is -- In all these cases, we will process at the higher level (and then -- this node will be processed during the downwards recursion that - -- is part of the processing in Minimize_Eliminate_Overflow_Checks). + -- is part of the processing in Minimize_Eliminate_Overflows). if Is_Signed_Integer_Arithmetic_Op (P) or else Nkind (P) in N_Membership_Test @@ -1127,7 +1131,7 @@ package body Checks is -- will still be in Bignum mode if either of its operands are of type -- Bignum). - Minimize_Eliminate_Overflow_Checks (Op, Lo, Hi, Top_Level => True); + Minimize_Eliminate_Overflows (Op, Lo, Hi, Top_Level => True); -- That call may but does not necessarily change the result type of Op. -- It is the job of this routine to undo such changes, so that at the @@ -1213,7 +1217,7 @@ package body Checks is -- Here we know the result is Long_Long_Integer'Base, of that it has -- been rewritten because the parent operation is a conversion. See - -- Apply_Arithmetic_Overflow_Checked_Suppressed.Conversion_Optimization. + -- Apply_Arithmetic_Overflow_Strict.Conversion_Optimization. else pragma Assert @@ -1678,7 +1682,7 @@ package body Checks is Left : constant Node_Id := Left_Opnd (N); Right : constant Node_Id := Right_Opnd (N); - Mode : constant Overflow_Check_Type := Overflow_Check_Mode (Typ); + Mode : constant Overflow_Check_Type := Overflow_Check_Mode; -- Current overflow checking mode LLB : Uint; @@ -1693,15 +1697,13 @@ package body Checks is -- Don't actually use this value begin - -- If we are operating in MINIMIZED or ELIMINATED mode, and the - -- Do_Overflow_Check flag is set and we are operating on signed - -- integer types, then the only thing this routine does is to call - -- Apply_Arithmetic_Overflow_Minimized_Eliminated. That procedure will - -- (possibly later on during recursive downward calls), make sure that - -- any needed overflow and division checks are properly applied. + -- If we are operating in MINIMIZED or ELIMINATED mode, and we are + -- operating on signed integer types, then the only thing this routine + -- does is to call Apply_Arithmetic_Overflow_Minimized_Eliminated. That + -- procedure will (possibly later on during recursive downward calls), + -- ensure that any needed overflow/division checks are properly applied. if Mode in Minimized_Or_Eliminated - and then Do_Overflow_Check (N) and then Is_Signed_Integer_Type (Typ) then Apply_Arithmetic_Overflow_Minimized_Eliminated (N); @@ -1726,7 +1728,9 @@ package body Checks is -- Deal with overflow check - if Do_Overflow_Check (N) and then Mode /= Suppressed then + if Do_Overflow_Check (N) + and then not Overflow_Checks_Suppressed (Etype (N)) + then -- Test for extremely annoying case of xxx'First divided by -1 -- for division of signed integer types (only overflow case). @@ -3093,6 +3097,7 @@ package body Checks is begin if not Overflow_Checks_Suppressed (Target_Base) + and then not Overflow_Checks_Suppressed (Target_Type) and then not In_Subrange_Of (Expr_Type, Target_Base, Fixed_Int => Conv_OK) and then not Float_To_Int @@ -4420,7 +4425,7 @@ package body Checks is procedure Enable_Overflow_Check (N : Node_Id) is Typ : constant Entity_Id := Base_Type (Etype (N)); - Mode : constant Overflow_Check_Type := Overflow_Check_Mode (Etype (N)); + Mode : constant Overflow_Check_Type := Overflow_Check_Mode; Chk : Nat; OK : Boolean; Ent : Entity_Id; @@ -4438,7 +4443,7 @@ package body Checks is -- No check if overflow checks suppressed for type of node - if Mode = Suppressed then + if Overflow_Checks_Suppressed (Etype (N)) then return; -- Nothing to do for unsigned integer types, which do not overflow @@ -4447,23 +4452,28 @@ package body Checks is return; end if; - -- This is the point at which processing for CHECKED mode diverges + -- This is the point at which processing for STRICT mode diverges -- from processing for MINIMIZED/ELIMINATED modes. This divergence is -- probably more extreme that it needs to be, but what is going on here -- is that when we introduced MINIMIZED/ELIMINATED modes, we wanted - -- to leave the processing for CHECKED mode untouched. There were + -- to leave the processing for STRICT mode untouched. There were -- two reasons for this. First it avoided any incompatible change of - -- behavior. Second, it guaranteed that CHECKED mode continued to be + -- behavior. Second, it guaranteed that STRICT mode continued to be -- legacy reliable. - -- The big difference is that in CHECKED mode there is a fair amount of + -- The big difference is that in STRICT mode there is a fair amount of -- circuitry to try to avoid setting the Do_Overflow_Check flag if we -- know that no check is needed. We skip all that in the two new modes, -- since really overflow checking happens over a whole subtree, and we -- do the corresponding optimizations later on when applying the checks. if Mode in Minimized_Or_Eliminated then - Activate_Overflow_Check (N); + if not (Overflow_Checks_Suppressed (Etype (N))) + and then not (Is_Entity_Name (N) + and then Overflow_Checks_Suppressed (Entity (N))) + then + Activate_Overflow_Check (N); + end if; if Debug_Flag_CC then w ("Minimized/Eliminated mode"); @@ -4472,7 +4482,7 @@ package body Checks is return; end if; - -- Remainder of processing is for Checked case, and is unchanged from + -- Remainder of processing is for STRICT case, and is unchanged from -- earlier versions preceding the addition of MINIMIZED/ELIMINATED. -- Nothing to do if the range of the result is known OK. We skip this @@ -6685,9 +6695,9 @@ package body Checks is New_Reference_To (M, Loc)))))); end Make_Bignum_Block; - ---------------------------------------- - -- Minimize_Eliminate_Overflow_Checks -- - ---------------------------------------- + ---------------------------------- + -- Minimize_Eliminate_Overflows -- + ---------------------------------- -- This is a recursive routine that is called at the top of an expression -- tree to properly process overflow checking for a whole subtree by making @@ -6697,14 +6707,13 @@ package body Checks is -- it would interfere with semantic analysis). -- What happens is that if MINIMIZED/ELIMINATED mode is in effect then - -- the operator expansion routines, as well as the expansion routines - -- for if/case expression test the Do_Overflow_Check flag and if it is - -- set they (for the moment) do nothing except call the routine to apply - -- the overflow check (Apply_Arithmetic_Overflow_Check). That routine - -- does nothing for non top-level nodes, so at the point where the call - -- is made for the top level node, the entire expression subtree has not - -- been expanded, or processed for overflow. All that has to happen as a - -- result of the top level call to this routine. + -- the operator expansion routines, as well as the expansion routines for + -- if/case expression, do nothing (for the moment) except call the routine + -- to apply the overflow check (Apply_Arithmetic_Overflow_Check). That + -- routine does nothing for non top-level nodes, so at the point where the + -- call is made for the top level node, the entire expression subtree has + -- not been expanded, or processed for overflow. All that has to happen as + -- a result of the top level call to this routine. -- As noted above, the overflow processing works by making recursive calls -- for the operands, and figuring out what to do, based on the processing @@ -6716,11 +6725,10 @@ package body Checks is -- the node (if it has been modified by the overflow check processing). The -- Analyzed_Flag is set to False before the reexpand/reanalyze. To avoid -- a recursive call into the whole overflow apparatus, an important rule - -- for this call is that either Do_Overflow_Check must be False, or if - -- it is set, then the overflow checking mode must be temporarily set - -- to CHECKED/SUPPRESSED. Either step will avoid the unwanted recursion. + -- for this call is that the overflow handling mode must be temporarily set + -- to STRICT. - procedure Minimize_Eliminate_Overflow_Checks + procedure Minimize_Eliminate_Overflows (N : Node_Id; Lo : out Uint; Hi : out Uint; @@ -6730,7 +6738,7 @@ package body Checks is pragma Assert (Is_Signed_Integer_Type (Rtyp)); -- Result type, must be a signed integer type - Check_Mode : constant Overflow_Check_Type := Overflow_Check_Mode (Empty); + Check_Mode : constant Overflow_Check_Type := Overflow_Check_Mode; pragma Assert (Check_Mode in Minimized_Or_Eliminated); Loc : constant Source_Ptr := Sloc (N); @@ -6764,18 +6772,24 @@ package body Checks is -- Set True if one or more operands is already of type Long_Long_Integer -- which means that if the result is known to be in the result type -- range, then we must convert such operands back to the result type. - -- This switch is properly set only when Bignum_Operands is False. - - procedure Reexpand (C : Suppressed_Or_Checked); - -- This is called when we have not modified the node, so we do not need - -- to reanalyze it. But we do want to reexpand it in either SUPPRESSED - -- or CHECKED mode (as indicated by the argument C) to get proper - -- expansion. It is important that we reset the mode to SUPPRESSED or - -- CHECKED, since if we leave it in MINIMIZED or ELIMINATED mode we - -- would reenter this routine recursively which would not be good! - -- Note that this is not just an optimization, testing has showed up - -- several complex cases in which reanalyzing an already analyzed node - -- causes incorrect behavior. + + procedure Reanalyze (Typ : Entity_Id; Suppress : Boolean := False); + -- This is called when we have modified the node and we therefore need + -- to reanalyze it. It is important that we reset the mode to STRICT for + -- this reanalysis, since if we leave it in MINIMIZED or ELIMINATED mode + -- we would reenter this routine recursively which would not be good! + -- The argument Suppress is set True if we also want to suppress + -- overflow checking for the reexpansion (this is set when we know + -- overflow is not possible). Typ is the type for the reanalysis. + + procedure Reexpand (Suppress : Boolean := False); + -- This is like Reanalyze, but does not do the Analyze step, it only + -- does a reexpansion. We do this reexpansion in STRICT mode, so that + -- instead of reentering the MINIMIZED/ELIMINATED mode processing, we + -- follow the normal expansion path (e.g. converting A**4 to A**2**2). + -- Note that skipping reanalysis is not just an optimization, testing + -- has showed up several complex cases in which reanalyzing an already + -- analyzed node causes incorrect behavior. function In_Result_Range return Boolean; -- Returns True iff Lo .. Hi are within range of the result type @@ -6829,25 +6843,62 @@ package body Checks is end if; end Min; + --------------- + -- Reanalyze -- + --------------- + + procedure Reanalyze (Typ : Entity_Id; Suppress : Boolean := False) is + Svg : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_General; + Sva : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_Assertions; + Svo : constant Boolean := + Scope_Suppress.Suppress (Overflow_Check); + + begin + Scope_Suppress.Overflow_Checks_General := Strict; + Scope_Suppress.Overflow_Checks_Assertions := Strict; + + if Suppress then + Scope_Suppress.Suppress (Overflow_Check) := True; + end if; + + Analyze_And_Resolve (N, Typ); + + Scope_Suppress.Suppress (Overflow_Check) := Svo; + Scope_Suppress.Overflow_Checks_General := Svg; + Scope_Suppress.Overflow_Checks_Assertions := Sva; + end Reanalyze; + -------------- -- Reexpand -- -------------- - procedure Reexpand (C : Suppressed_Or_Checked) is + procedure Reexpand (Suppress : Boolean := False) is Svg : constant Overflow_Check_Type := Scope_Suppress.Overflow_Checks_General; Sva : constant Overflow_Check_Type := Scope_Suppress.Overflow_Checks_Assertions; + Svo : constant Boolean := + Scope_Suppress.Suppress (Overflow_Check); + begin - Scope_Suppress.Overflow_Checks_General := C; - Scope_Suppress.Overflow_Checks_Assertions := C; + Scope_Suppress.Overflow_Checks_General := Strict; + Scope_Suppress.Overflow_Checks_Assertions := Strict; Set_Analyzed (N, False); + + if Suppress then + Scope_Suppress.Suppress (Overflow_Check) := True; + end if; + Expand (N); + + Scope_Suppress.Suppress (Overflow_Check) := Svo; Scope_Suppress.Overflow_Checks_General := Svg; Scope_Suppress.Overflow_Checks_Assertions := Sva; end Reexpand; - -- Start of processing for Minimize_Eliminate_Overflow_Checks + -- Start of processing for Minimize_Eliminate_Overflows begin -- Case where we do not have a signed integer arithmetic operation @@ -6884,14 +6935,14 @@ package body Checks is begin Bignum_Operands := False; - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Then_DE, Lo, Hi, Top_Level => False); if Lo = No_Uint then Bignum_Operands := True; end if; - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Else_DE, Rlo, Rhi, Top_Level => False); if Rlo = No_Uint then @@ -6918,8 +6969,7 @@ package body Checks is Convert_To_Bignum (Else_DE)), Is_Elsif => Is_Elsif (N))); - Analyze_And_Resolve - (N, RTE (RE_Bignum), Suppress => Overflow_Check); + Reanalyze (RTE (RE_Bignum), Suppress => True); -- If we have no Long_Long_Integer operands, then we are in result -- range, since it means that none of our operands felt the need @@ -6930,7 +6980,7 @@ package body Checks is elsif not Long_Long_Integer_Operands then Set_Do_Overflow_Check (N, False); - Reexpand (Suppressed); + Reexpand; -- Otherwise convert us to long long integer mode. Note that we -- don't need any further overflow checking at this level. @@ -6943,8 +6993,7 @@ package body Checks is -- Now reanalyze with overflow checks off Set_Do_Overflow_Check (N, False); - Set_Analyzed (N, False); - Analyze_And_Resolve (N, LLIB, Suppress => Overflow_Check); + Reanalyze (LLIB, Suppress => True); end if; end; @@ -6968,7 +7017,7 @@ package body Checks is Aexp : constant Node_Id := Expression (Alt); begin - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Aexp, Lo, Hi, Top_Level => False); if Lo = No_Uint then @@ -6991,7 +7040,7 @@ package body Checks is if not (Bignum_Operands or Long_Long_Integer_Operands) then Set_Do_Overflow_Check (N, False); - Reexpand (Suppressed); + Reexpand (Suppress => True); -- Otherwise we are going to rebuild the case expression using -- either bignum or long long integer operands throughout. @@ -7028,7 +7077,7 @@ package body Checks is Expression => Expression (N), Alternatives => New_Alts)); - Analyze_And_Resolve (N, Rtype, Suppress => Overflow_Check); + Reanalyze (Rtype, Suppress => True); end; end if; end; @@ -7040,11 +7089,11 @@ package body Checks is -- operands to get the ranges (and to properly process the subtree -- that lies below us!) - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Right_Opnd (N), Rlo, Rhi, Top_Level => False); if Binary then - Minimize_Eliminate_Overflow_Checks + Minimize_Eliminate_Overflows (Left_Opnd (N), Llo, Lhi, Top_Level => False); end if; @@ -7356,7 +7405,7 @@ package body Checks is and then In_Result_Range then Set_Do_Overflow_Check (N, False); - Reexpand (Suppressed); + Reexpand (Suppress => True); return; -- Here we know that we are not in the result range, and in the general @@ -7380,22 +7429,17 @@ package body Checks is and then Nkind (Parent (N)) /= N_Type_Conversion then - -- Here we will keep the original types, but we do need an overflow - -- check, so we will set Do_Overflow_Check to True (actually it is - -- true already, or how would we have got here?). - - pragma Assert (Do_Overflow_Check (N)); - Set_Analyzed (N, False); + -- Here keep original types, but we need to complete analysis -- One subtlety. We can't just go ahead and do an analyze operation -- here because it will cause recursion into the whole MINIMIZED/ -- ELIMINATED overflow processing which is not what we want. Here -- we are at the top level, and we need a check against the result - -- mode (i.e. we want to use Checked mode). So do exactly that! + -- mode (i.e. we want to use STRICT mode). So do exactly that! -- Also, we have not modified the node, so this is a case where -- we need to reexpand, but not reanalyze. - Reexpand (Checked); + Reexpand; return; -- Cases where we do the operation in Bignum mode. This happens either @@ -7421,17 +7465,18 @@ package body Checks is -- set True). In this case, there is no point in moving into Bignum -- mode to prevent overflow if the caller will immediately convert -- the Bignum value back to LLI with an overflow check. It's more - -- efficient to stay in LLI mode with an overflow check. + -- efficient to stay in LLI mode with an overflow check (if needed) if Check_Mode = Minimized or else (Top_Level and not Bignum_Operands) then - Enable_Overflow_Check (N); + if Do_Overflow_Check (N) then + Enable_Overflow_Check (N); + end if; - -- Since we are doing an overflow check, the result has to be in - -- Long_Long_Integer mode, so adjust the possible range to reflect - -- this. Note these calls also change No_Uint values from the top - -- level case to LLI bounds. + -- The result now has to be in Long_Long_Integer mode, so adjust + -- the possible range to reflect this. Note these calls also + -- change No_Uint values from the top level case to LLI bounds. Max (Lo, LLLo); Min (Hi, LLHi); @@ -7500,7 +7545,7 @@ package body Checks is Make_Function_Call (Loc, Name => New_Occurrence_Of (Fent, Loc), Parameter_Associations => Args)); - Analyze_And_Resolve (N, RTE (RE_Bignum)); + Reanalyze (RTE (RE_Bignum), Suppress => True); -- Indicate result is Bignum mode @@ -7557,48 +7602,36 @@ package body Checks is -- we will complete any division checks (since we have not changed the -- setting of the Do_Division_Check flag). - -- If no overflow check, suppress overflow check to avoid an infinite - -- recursion into this procedure. + -- We do this reanalysis in STRICT mode to avoid recursion into the + -- MINIMIZED/ELIMINATED handling, since we are now done with that! - if not Do_Overflow_Check (N) then - Analyze_And_Resolve (N, LLIB, Suppress => Overflow_Check); + declare + SG : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_General; + SA : constant Overflow_Check_Type := + Scope_Suppress.Overflow_Checks_Assertions; - -- If an overflow check is required, do it in normal CHECKED mode. - -- That avoids an infinite recursion, making sure we get a normal - -- overflow check. + begin + Scope_Suppress.Overflow_Checks_General := Strict; + Scope_Suppress.Overflow_Checks_Assertions := Strict; - else - declare - SG : constant Overflow_Check_Type := - Scope_Suppress.Overflow_Checks_General; - SA : constant Overflow_Check_Type := - Scope_Suppress.Overflow_Checks_Assertions; - begin - Scope_Suppress.Overflow_Checks_General := Checked; - Scope_Suppress.Overflow_Checks_Assertions := Checked; - Analyze_And_Resolve (N, LLIB); - Scope_Suppress.Overflow_Checks_General := SG; - Scope_Suppress.Overflow_Checks_Assertions := SA; - end; - end if; - end Minimize_Eliminate_Overflow_Checks; + if not Do_Overflow_Check (N) then + Reanalyze (LLIB, Suppress => True); + else + Reanalyze (LLIB); + end if; + + Scope_Suppress.Overflow_Checks_General := SG; + Scope_Suppress.Overflow_Checks_Assertions := SA; + end; + end Minimize_Eliminate_Overflows; ------------------------- -- Overflow_Check_Mode -- ------------------------- - function Overflow_Check_Mode (E : Entity_Id) return Overflow_Check_Type is + function Overflow_Check_Mode return Overflow_Check_Type is begin - -- Check overflow suppressed on entity - - if Present (E) and then Checks_May_Be_Suppressed (E) then - if Is_Check_Suppressed (E, Overflow_Check) then - return Suppressed; - end if; - end if; - - -- Else return appropriate scope setting - if In_Assertion_Expr = 0 then return Scope_Suppress.Overflow_Checks_General; else @@ -7612,7 +7645,11 @@ package body Checks is function Overflow_Checks_Suppressed (E : Entity_Id) return Boolean is begin - return Overflow_Check_Mode (E) = Suppressed; + if Present (E) and then Checks_May_Be_Suppressed (E) then + return Is_Check_Suppressed (E, Overflow_Check); + else + return Scope_Suppress.Suppress (Overflow_Check); + end if; end Overflow_Checks_Suppressed; ----------------------------- |