[Ada] Fix leak of Do_Range_Check flag in -gnatVa mode

This fixes a small glitch in Insert_Valid_Check, which needs to
propagate the Do_Range_Check flag onto the rewritten expression, but
uses its Original_Node as the source of the copy.  Now Original_Node
does not necessarily point to the node that was just rewritten, but to
the ultimately original node, which is not the same node if the
expression was rewritten multiple times.  The end result is that a
stalled Do_Range_Check flag can be wrongly resintated and leak to the
code generator.

2019-08-12  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* checks.adb (Insert_Valid_Check): Do not retrieve the
	Do_Range_Check flag from the Original_Node but from the
	Validated_Object.  Remove useless bypass for floating-point
	types.

gcc/testsuite/

	* gnat.dg/range_check7.adb: New testcase.

From-SVN: r274285

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2f3ec7b589e31191f839d43c6d7b1cdad21d7d40..362efba5487fb4df65343dbb42b6dda134ee205c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-08-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * checks.adb (Insert_Valid_Check): Do not retrieve the
+       Do_Range_Check flag from the Original_Node but from the
+       Validated_Object.  Remove useless bypass for floating-point
+       types.
+
 2019-08-12  Yannick Moy  <moy@adacore.com>
 
        * sem_util.adb, sem_util.ads (Traverse_More_Func,

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 5d8efce90800953ac53fa1d3cc38231ab3624419..470ea3f2fb7eaa6990ba57a1661c67e48f67cd49 100644 (file)
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -7589,17 +7589,14 @@ package body Checks is
 
             Set_Validated_Object (Var_Id, New_Copy_Tree (Exp));
 
-            --  Reset the Do_Range_Check flag so it doesn't leak elsewhere
-
-            Set_Do_Range_Check (Validated_Object (Var_Id), False);
-
             Rewrite (Exp, New_Occurrence_Of (Var_Id, Loc));
 
-            --  Copy the Do_Range_Check flag over to the new Exp, so it doesn't
-            --  get lost. Floating point types are handled elsewhere.
+            --  Move the Do_Range_Check flag over to the new Exp so it doesn't
+            --  get lost and doesn't leak elsewhere.
 
-            if not Is_Floating_Point_Type (Typ) then
-               Set_Do_Range_Check (Exp, Do_Range_Check (Original_Node (Exp)));
+            if Do_Range_Check (Validated_Object (Var_Id)) then
+               Set_Do_Range_Check (Exp);
+               Set_Do_Range_Check (Validated_Object (Var_Id), False);
             end if;
 
             PV := New_Occurrence_Of (Var_Id, Loc);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 90ce94df7551984e2fdbc22089c5fa01af78db3f..ad20649db27a466712129dac62a476e164480fe8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-08-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/range_check7.adb: New testcase.
+
 2019-08-12  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/range_check6.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/range_check7.adb b/gcc/testsuite/gnat.dg/range_check7.adb
new file mode 100644 (file)
index 0000000..def43c9
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/range_check7.adb
@@ -0,0 +1,22 @@
+--  { dg-do compile }
+--  { dg-options "-gnatVa" }
+
+procedure Range_Check7 is
+
+  type Short is range -32768 .. 32767;
+
+  type Int is range -2 ** 31 .. 2 ** 31 - 1;
+
+  subtype Nat is Int range 0 .. Int'Last;
+
+  type Ptr is access all Short;
+
+  procedure Proc (P : Ptr) is
+    N : constant Nat := Nat (P.all);
+  begin
+    null;
+  end;
+
+begin
+  null;
+end;