[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 17c27abcfd599c53a38a868ddb557223b43ddc5f..e5aba8b08fe47e2653f66319495c65dbe441e8b0 100644 (file)
--- 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 6f73ec3bc1fb962350131d16081a095f7fad7777..77809bc16dd10a666b36e5fb164c5f7733475860 100644 (file)
--- 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 af4a009af7c4a4e776a0bc6ba81276ae8ba1ddee..e1f16789a78746efc17a9df940e870b6e0e0dfcd 100644 (file)
--- 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 (file)
index 0000000..d134a79
--- /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 (file)
index 0000000..50c1b1d
--- /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 (file)
index 0000000..d5864c6
--- /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;