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

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-07-09  Javier Miranda  <mira...@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.
--- gcc/ada/exp_util.adb
+++ 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);

--- /dev/null
new file mode 100644
+++ 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;
+

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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;

Reply via email to