* gcc-interface/trans.c (emit_check): Do not touch TREE_SIDE_EFFECTS.
authorEric Botcazou <ebotcazou@adacore.com>
Thu, 17 Sep 2015 15:51:40 +0000 (15:51 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Thu, 17 Sep 2015 15:51:40 +0000 (15:51 +0000)
From-SVN: r227879

gcc/ada/ChangeLog
gcc/ada/gcc-interface/trans.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/overflow_sum3.adb [new file with mode: 0644]

index d11227b083905258710bf5579bbd10897a8194ab..ad9cf14060c93cbb24f5d5297db42e77b0475d5e 100644 (file)
@@ -1,3 +1,7 @@
+2015-09-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (emit_check): Do not touch TREE_SIDE_EFFECTS.
+
 2015-09-14  Pierre-Marie de Rodat  <derodat@adacore.com>
 
        * gcc-interface/misc.c (gnat_post_options): Issue a warning if
index fea8e15c5d3ff32bb8606c776308f488771b2b49..96f0c55d48fdc523649db257d41544f6bdca3245 100644 (file)
@@ -8798,29 +8798,32 @@ emit_index_check (tree gnu_array_object, tree gnu_expr, tree gnu_low,
      gnu_expr, CE_Index_Check_Failed, gnat_node);
 }
 \f
-/* GNU_COND contains the condition corresponding to an access, discriminant or
-   range check of value GNU_EXPR.  Build a COND_EXPR that returns GNU_EXPR if
-   GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true.
-   REASON is the code that says why the exception was raised.  GNAT_NODE is
-   the GNAT node conveying the source location for which the error should be
-   signaled.  */
+/* GNU_COND contains the condition corresponding to an index, overflow or
+   range check of value GNU_EXPR.  Build a COND_EXPR that returns GNU_EXPR
+   if GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true.
+   REASON is the code that says why the exception is raised.  GNAT_NODE is
+   the node conveying the source location for which the error should be
+   signaled.
+
+   We used to propagate TREE_SIDE_EFFECTS from GNU_EXPR to the COND_EXPR,
+   overwriting the setting inherited from the call statement, on the ground
+   that the expression need not be evaluated just for the check.  However
+   that's incorrect because, in the GCC type system, its value is presumed
+   to be valid so its comparison against the type bounds always yields true
+   and, therefore, could be done without evaluating it; given that it can
+   be a computation that overflows the bounds, the language may require the
+   check to fail and thus the expression to be evaluated in this case.  */
 
 static tree
 emit_check (tree gnu_cond, tree gnu_expr, int reason, Node_Id gnat_node)
 {
   tree gnu_call
     = build_call_raise (reason, gnat_node, N_Raise_Constraint_Error);
-  tree gnu_result
-    = fold_build3 (COND_EXPR, TREE_TYPE (gnu_expr), gnu_cond,
-                  build2 (COMPOUND_EXPR, TREE_TYPE (gnu_expr), gnu_call,
-                          convert (TREE_TYPE (gnu_expr), integer_zero_node)),
-                  gnu_expr);
-
-  /* GNU_RESULT has side effects if and only if GNU_EXPR has:
-     we don't need to evaluate it just for the check.  */
-  TREE_SIDE_EFFECTS (gnu_result) = TREE_SIDE_EFFECTS (gnu_expr);
-
-  return gnu_result;
+  return
+    fold_build3 (COND_EXPR, TREE_TYPE (gnu_expr), gnu_cond,
+                build2 (COMPOUND_EXPR, TREE_TYPE (gnu_expr), gnu_call,
+                        convert (TREE_TYPE (gnu_expr), integer_zero_node)),
+                gnu_expr);
 }
 \f
 /* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing overflow
index 82091b846979f094e626961675d3277c3a17da68..0a3c7104539858cfce490f867aaa94930561a15b 100644 (file)
@@ -1,3 +1,7 @@
+2015-09-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/overflow_sum3.adb: New test.
+
 2015-09-17  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc.target/arm/stack-checking.c: New test.
diff --git a/gcc/testsuite/gnat.dg/overflow_sum3.adb b/gcc/testsuite/gnat.dg/overflow_sum3.adb
new file mode 100644 (file)
index 0000000..d107843
--- /dev/null
@@ -0,0 +1,19 @@
+--  { dg-do run }
+--  { dg-options "-gnato" }
+
+procedure Overflow_Sum3 is
+
+   function Ident (I : Integer) return Integer is
+   begin
+      return I;
+   end;
+
+   X : Short_Short_Integer := Short_Short_Integer (Ident (127));
+
+begin
+   if X+1 <= 127 then
+      raise Program_Error;
+   end if;
+exception
+   when Constraint_Error => null;
+end;