From 1361a4fbe10d119c76339f06992ac60de54f124d Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 12 Aug 2019 08:59:18 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/checks.adb | 13 +++++-------- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/range_check7.adb | 22 ++++++++++++++++++++++ 4 files changed, 38 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/range_check7.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2f3ec7b589e..362efba5487 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-08-12 Eric Botcazou + + * 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 * sem_util.adb, sem_util.ads (Traverse_More_Func, diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 5d8efce9080..470ea3f2fb7 100644 --- 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 90ce94df755..ad20649db27 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-08-12 Eric Botcazou + + * gnat.dg/range_check7.adb: New testcase. + 2019-08-12 Eric Botcazou * 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 index 00000000000..def43c9a029 --- /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; -- 2.30.2