Patchwork [Ada] Remaining fixes to get MINIMIZED through test suite

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 4, 2012, 9:10 a.m.
Message ID <20121004091017.GA1027@adacore.com>
Download mbox | patch
Permalink /patch/189069/
State New
Headers show

Comments

Arnaud Charlet - Oct. 4, 2012, 9:10 a.m.
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.

Patch

Index: types.ads
===================================================================
--- types.ads	(revision 192066)
+++ types.ads	(working copy)
@@ -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
Index: checks.adb
===================================================================
--- checks.adb	(revision 192066)
+++ checks.adb	(working copy)
@@ -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
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 192066)
+++ exp_ch4.adb	(working copy)
@@ -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;
 
Index: sem_eval.adb
===================================================================
--- sem_eval.adb	(revision 192066)
+++ sem_eval.adb	(working copy)
@@ -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.