[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 17c27ab..e5aba8b 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 6f73ec3..77809bc 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 af4a009..e1f1678 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;