From 5da544339b2b3b3d00d3dd5b91c06d2d09a386b2 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Tue, 9 Jul 2019 07:54:19 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_util.adb | 4 ++++ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/range_check3.adb | 13 +++++++++++++ gcc/testsuite/gnat.dg/range_check3_pkg.adb | 18 ++++++++++++++++++ gcc/testsuite/gnat.dg/range_check3_pkg.ads | 9 +++++++++ 6 files changed, 54 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/range_check3.adb create mode 100644 gcc/testsuite/gnat.dg/range_check3_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/range_check3_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 17c27ab..e5aba8b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-07-09 Javier Miranda + + * exp_util.adb (Remove_Side_Effects): Preserve the + Do_Range_Check flag. + 2019-07-09 Yannick Moy * 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 --- 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 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-07-09 Javier Miranda + + * gnat.dg/range_check3.adb, gnat.dg/range_check3_pkg.adb, + gnat.dg/range_check3_pkg.ads: New testcase. + 2019-07-09 Ed Schonberg * 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 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 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 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; -- 2.7.4