===================================================================
@@ -737,7 +737,9 @@
subtype Minimized_Or_Eliminated is
Overflow_Check_Type range Minimized .. Eliminated;
- -- Definte subtypes so that clients don't need to know ordering. Note that
+ subtype Suppressed_Or_Checked is
+ Overflow_Check_Type range Suppressed .. Checked;
+ -- Define subtypes so that clients don't need to know ordering. Note that
-- Overflow_Check_Type is not marked as an ordered enumeration type.
-- The following structure captures the state of check suppression or
===================================================================
@@ -34,6 +34,7 @@
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Elists; use Elists;
+with Expander; use Expander;
with Eval_Fat; use Eval_Fat;
with Freeze; use Freeze;
with Lib; use Lib;
@@ -1272,8 +1273,7 @@
Apply_Range_Check (N, Typ);
end if;
- elsif (Is_Record_Type (Typ)
- or else Is_Private_Type (Typ))
+ elsif (Is_Record_Type (Typ) or else Is_Private_Type (Typ))
and then Has_Discriminants (Base_Type (Typ))
and then Is_Constrained (Typ)
then
@@ -6709,10 +6709,12 @@
-- to be done in bignum mode), and the determined ranges of the operands.
-- After possible rewriting of a constituent subexpression node, a call is
- -- made to reanalyze the node after setting Analyzed to False. To avoid a
- -- recursive call into the whole overflow apparatus, and important rule for
- -- this reanalysis call is that either Do_Overflow_Check must be False, or
- -- if it is set, then the overflow checking mode must be temporarily set
+ -- made to either reexpand the node (if nothing has changed) or reanalyze
+ -- the node (if it has been modified by the overflow check processing).
+ -- The Analyzed_flag is set False before the reexpand/reanalyze. To avoid
+ -- a recursive call into the whole overflow apparatus, and 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.
procedure Minimize_Eliminate_Overflow_Checks
@@ -6761,6 +6763,17 @@
-- 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 modifed the node, so we do not need
+ -- to reanalyze it. But we do want to reexpand it in either CHECKED
+ -- or SUPPRESSED 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 renalyzing 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
@@ -6813,6 +6826,24 @@
end if;
end Min;
+ --------------
+ -- Reexpand --
+ --------------
+
+ procedure Reexpand (C : Suppressed_Or_Checked) is
+ Svg : constant Overflow_Check_Type :=
+ Scope_Suppress.Overflow_Checks_General;
+ Sva : constant Overflow_Check_Type :=
+ Scope_Suppress.Overflow_Checks_Assertions;
+ begin
+ Scope_Suppress.Overflow_Checks_General := C;
+ Scope_Suppress.Overflow_Checks_Assertions := C;
+ Set_Analyzed (N, False);
+ Expand (N);
+ Scope_Suppress.Overflow_Checks_General := Svg;
+ Scope_Suppress.Overflow_Checks_Assertions := Sva;
+ end Reexpand;
+
-- Start of processing for Minimize_Eliminate_Overflow_Checks
begin
@@ -6890,13 +6921,13 @@
-- 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
-- to worry about overflow (otherwise it would have already been
- -- converted to long long integer or bignum). We reanalyze to
- -- complete the expansion of the if expression
+ -- converted to long long integer or bignum). We reexpand to
+ -- complete the expansion of the if expression (but we do not
+ -- need to reanalyze).
elsif not Long_Long_Integer_Operands then
Set_Do_Overflow_Check (N, False);
- Set_Analyzed (N, False);
- Analyze_And_Resolve (N, Suppress => Overflow_Check);
+ Reexpand (Suppressed);
-- Otherwise convert us to long long integer mode. Note that we
-- don't need any further overflow checking at this level.
@@ -6953,14 +6984,13 @@
-- that none of our dependent expressions could raise overflow.
-- In this case, we simply return with no changes except for
-- resetting the overflow flag, since we are done with overflow
- -- checks for this node. We will reset the Analyzed flag so that
- -- we will properly reexpand and get the needed expansion for
- -- the case expression.
+ -- checks for this node. We will reexpand to get the needed
+ -- expansion for the case expression, but we do not need to
+ -- renalyze, since nothing has changed.
if not (Bignum_Operands or Long_Long_Integer_Operands) then
Set_Do_Overflow_Check (N, False);
- Set_Analyzed (N, False);
- Analyze_And_Resolve (N, Suppress => Overflow_Check);
+ Reexpand (Suppressed);
-- Otherwise we are going to rebuild the case expression using
-- either bignum or long long integer operands throughout.
@@ -7381,18 +7411,20 @@
end case;
end if;
- -- If we know we are in the result range, and we do not have Bignum
- -- operands or Long_Long_Integer operands, we can just renalyze with
- -- overflow checks turned off (since we know we cannot have overflow).
- -- As always the reanalysis is required to complete expansion of the
- -- operator, and we prevent recursion by suppressing the check.
+ -- Here for the case where we have not rewritten anything (no bignum
+ -- operands or long long integer operands), and we know the result If we
+ -- know we are in the result range, and we do not have Bignum operands
+ -- or Long_Long_Integer operands, we can just reexpand with overflow
+ -- checks turned off (since we know we cannot have overflow). As always
+ -- the reexpansion is required to complete expansion of the operator,
+ -- but we do not need to reanalyze, and we prevent recursion by
+ -- suppressing the check,
if not (Bignum_Operands or Long_Long_Integer_Operands)
and then In_Result_Range
then
Set_Do_Overflow_Check (N, False);
- Set_Analyzed (N, False);
- Analyze_And_Resolve (N, Suppress => Overflow_Check);
+ Reexpand (Suppressed);
return;
-- Here we know that we are not in the result range, and in the general
@@ -7427,20 +7459,10 @@
-- 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!
+ -- Also, we have not modified the node, so this is a case where
+ -- we need to reexpand, but not reanalyze.
- declare
- Svg : constant Overflow_Check_Type :=
- Scope_Suppress.Overflow_Checks_General;
- Sva : 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);
- Scope_Suppress.Overflow_Checks_General := Svg;
- Scope_Suppress.Overflow_Checks_Assertions := Sva;
- end;
-
+ Reexpand (Checked);
return;
-- Cases where we do the operation in Bignum mode. This happens either
===================================================================
@@ -2331,7 +2331,7 @@
when N_Op_Eq =>
if Llo = Lhi and then Rlo = Rhi and then Llo = Rlo then
Set_True;
- elsif Llo > Rhi or else Rlo > Lhi then
+ elsif Llo > Rhi or else Lhi < Rlo then
Set_False;
end if;
@@ -2365,9 +2365,9 @@
when N_Op_Ne =>
if Llo = Lhi and then Rlo = Rhi and then Llo = Rlo then
+ Set_False;
+ elsif Llo > Rhi or else Lhi < Rlo then
Set_True;
- elsif Llo > Rhi or else Rlo > Lhi then
- Set_False;
end if;
end case;
===================================================================
@@ -942,9 +942,51 @@
end if;
end if;
- -- Try range analysis on variables and see if ranges are disjoint
+ -- First attempt is to decompose the expressions to extract a
+ -- constant offset resulting from the use of any of the forms:
+ -- expr + literal
+ -- expr - literal
+ -- typ'Succ (expr)
+ -- typ'Pred (expr)
+
+ -- Then we see if the two expressions are the same value, and if so
+ -- the result is obtained by comparing the offsets.
+
+ -- Note: the reason we do this test first is that it returns only
+ -- decisive results (with diff set), where other tests, like the
+ -- range test, may not be as so decisive. Consider for example
+ -- J .. J + 1. This code can conclude LT with a difference of 1,
+ -- even if the range of J is not known.
+
declare
+ Lnode : Node_Id;
+ Loffs : Uint;
+ Rnode : Node_Id;
+ Roffs : Uint;
+
+ begin
+ Compare_Decompose (L, Lnode, Loffs);
+ Compare_Decompose (R, Rnode, Roffs);
+
+ if Is_Same_Value (Lnode, Rnode) then
+ if Loffs = Roffs then
+ return EQ;
+
+ elsif Loffs < Roffs then
+ Diff.all := Roffs - Loffs;
+ return LT;
+
+ else
+ Diff.all := Loffs - Roffs;
+ return GT;
+ end if;
+ end if;
+ end;
+
+ -- Next, try range analysis and see if operand ranges are disjoint
+
+ declare
LOK, ROK : Boolean;
LLo, LHi : Uint;
RLo, RHi : Uint;
@@ -1074,42 +1116,6 @@
end if;
end if;
- -- Next attempt is to decompose the expressions to extract
- -- a constant offset resulting from the use of any of the forms:
-
- -- expr + literal
- -- expr - literal
- -- typ'Succ (expr)
- -- typ'Pred (expr)
-
- -- Then we see if the two expressions are the same value, and if so
- -- the result is obtained by comparing the offsets.
-
- declare
- Lnode : Node_Id;
- Loffs : Uint;
- Rnode : Node_Id;
- Roffs : Uint;
-
- begin
- Compare_Decompose (L, Lnode, Loffs);
- Compare_Decompose (R, Rnode, Roffs);
-
- if Is_Same_Value (Lnode, Rnode) then
- if Loffs = Roffs then
- return EQ;
-
- elsif Loffs < Roffs then
- Diff.all := Roffs - Loffs;
- return LT;
-
- else
- Diff.all := Loffs - Roffs;
- return GT;
- end if;
- end if;
- end;
-
-- Next attempt is to see if we have an entity compared with a
-- compile time known value, where there is a current value
-- conditional for the entity which can tell us the result.
This patch makes two minor corrections to fix two remaining tests in the test suite that failed if run with -gnato2 forced on. There is also a minor optimization of Compile_Time_Compare which improves the results in some cases (noticed during testing, but does not have any effect on the test suite). The first problem was in handling folding of /= in some cases which showed up as a bogus complaint about a length check failing. The following should compile cleanly with -gnato2 with no messages. 1. procedure Compov2 is 2. begin 3. for J in 1 .. 1 loop 4. declare 5. Dest : constant Wide_String (J .. J + 6) := "is_copy"; 6. begin 7. null; 8. end; 9. end loop; 10. end; The other case was a mistake in handling of case expressions, which shows up as an unexpected constraint error. No simple test case is available for this problem. Tested on x86_64-pc-linux-gnu, committed on trunk 2012-10-04 Robert Dewar <dewar@adacore.com> * checks.adb (Minimize_Eliminate_Overflow_Checks): Dont reanalyze if/case expression if nothing has changed (just reexpand). Stops case expression from generating incorrect temporary. * exp_ch4.adb (Expand_Compare_Minimize_Eliminate_Overflow): Fix cut and paste typo for range analysis in NE (not equal) case. * sem_eval.adb (Compile_Time_Compare): Small optimization to catch some more cases. * types.ads (Suppressed_Or_Checked): New subtype of Overflow_Check_Type.