From: Eric Botcazou <ebotcazou@adacore.com>
Date: Thu, 17 Sep 2015 15:51:40 +0000 (+0000)
Subject: * gcc-interface/trans.c (emit_check): Do not touch TREE_SIDE_EFFECTS.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4e9a8214b871baf45a47bc8b80e1e5ad897f7899;p=gcc.git

* gcc-interface/trans.c (emit_check): Do not touch TREE_SIDE_EFFECTS.

From-SVN: r227879
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d11227b0839..ad9cf14060c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index fea8e15c5d3..96f0c55d48f 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -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);
 }
 
-/* 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);
 }
 
 /* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing overflow
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 82091b84697..0a3c7104539 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
index 00000000000..d10784310ae
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/overflow_sum3.adb
@@ -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;