From: Javier Miranda <miranda@adacore.com>
Date: Tue, 9 Jul 2019 07:54:19 +0000 (+0000)
Subject: [Ada] Missing runtime range checks with -gnatVa
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5da544339b2b3b3d00d3dd5b91c06d2d09a386b2;p=gcc.git

[Ada] Missing runtime range checks with -gnatVa

Under validity checking mode the compiler may silently skip generating
code to perform runtime range checks.

2019-07-09  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* exp_util.adb (Remove_Side_Effects): Preserve the
	Do_Range_Check flag.

gcc/testsuite/

	* gnat.dg/range_check3.adb, gnat.dg/range_check3_pkg.adb,
	gnat.dg/range_check3_pkg.ads: New testcase.

From-SVN: r273278
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 17c27abcfd5..e5aba8b08fe 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-09  Javier Miranda  <miranda@adacore.com>
+
+	* exp_util.adb (Remove_Side_Effects): Preserve the
+	Do_Range_Check flag.
+
 2019-07-09  Yannick Moy  <moy@adacore.com>
 
 	* sinfo.ads: Refine comment for Do_Range_Check.
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 6f73ec3bc1f..77809bc16dd 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -11693,6 +11693,10 @@ package body Exp_Util is
 
       Set_Assignment_OK (Res, Assignment_OK (Exp));
 
+      --  Preserve the Do_Range_Check flag in all copies.
+
+      Set_Do_Range_Check (Res, Do_Range_Check (Exp));
+
       --  Finally rewrite the original expression and we are done
 
       Rewrite (Exp, Res);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index af4a009af7c..e1f16789a78 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-09  Javier Miranda  <miranda@adacore.com>
+
+	* gnat.dg/range_check3.adb, gnat.dg/range_check3_pkg.adb,
+	gnat.dg/range_check3_pkg.ads: New testcase.
+
 2019-07-09  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat.dg/generic_inst5.adb, gnat.dg/generic_inst6.adb,
diff --git a/gcc/testsuite/gnat.dg/range_check3.adb b/gcc/testsuite/gnat.dg/range_check3.adb
new file mode 100644
index 00000000000..d134a79cc56
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/range_check3.adb
@@ -0,0 +1,13 @@
+--  { dg-do run }
+--  { dg-options "-gnatVa" }
+
+with Range_Check3_Pkg; use Range_Check3_Pkg;
+procedure Range_Check3 is
+   Ptr : Array_Access;
+begin
+   Ptr := Allocate;
+   raise Program_Error;
+exception
+   when Constraint_Error => null;
+end Range_Check3;
+
diff --git a/gcc/testsuite/gnat.dg/range_check3_pkg.adb b/gcc/testsuite/gnat.dg/range_check3_pkg.adb
new file mode 100644
index 00000000000..50c1b1d7bcd
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/range_check3_pkg.adb
@@ -0,0 +1,18 @@
+package body Range_Check3_Pkg is
+   function One return Positive is
+   begin
+      return 1;
+   end One;
+
+   function Zero return Natural is
+   begin
+      return 0;
+   end Zero;
+
+   function Allocate return Array_Access is
+   begin
+      return
+        new Array_Type
+             (Positive (One) .. Positive (Zero)); -- Failed range check
+   end Allocate;
+end Range_Check3_Pkg;
diff --git a/gcc/testsuite/gnat.dg/range_check3_pkg.ads b/gcc/testsuite/gnat.dg/range_check3_pkg.ads
new file mode 100644
index 00000000000..d5864c6e188
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/range_check3_pkg.ads
@@ -0,0 +1,9 @@
+package Range_Check3_Pkg is
+   type Array_Type is array (Positive range <>) of Integer;
+   type Array_Access is access Array_Type;
+
+   function One  return Positive;
+   function Zero return Natural;
+
+   function Allocate return Array_Access;
+end Range_Check3_Pkg;