Commit 1361a4fb by Eric Botcazou Committed by Pierre-Marie de Rodat

[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
parent 935b02ae
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> 2019-08-12 Yannick Moy <moy@adacore.com>
* sem_util.adb, sem_util.ads (Traverse_More_Func, * sem_util.adb, sem_util.ads (Traverse_More_Func,
......
...@@ -7589,17 +7589,14 @@ package body Checks is ...@@ -7589,17 +7589,14 @@ package body Checks is
Set_Validated_Object (Var_Id, New_Copy_Tree (Exp)); 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)); Rewrite (Exp, New_Occurrence_Of (Var_Id, Loc));
-- Copy the Do_Range_Check flag over to the new Exp, so it doesn't -- Move the Do_Range_Check flag over to the new Exp so it doesn't
-- get lost. Floating point types are handled elsewhere. -- get lost and doesn't leak elsewhere.
if not Is_Floating_Point_Type (Typ) then if Do_Range_Check (Validated_Object (Var_Id)) then
Set_Do_Range_Check (Exp, Do_Range_Check (Original_Node (Exp))); Set_Do_Range_Check (Exp);
Set_Do_Range_Check (Validated_Object (Var_Id), False);
end if; end if;
PV := New_Occurrence_Of (Var_Id, Loc); PV := New_Occurrence_Of (Var_Id, Loc);
......
2019-08-12 Eric Botcazou <ebotcazou@adacore.com> 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. * gnat.dg/range_check6.adb: New testcase.
2019-08-11 Iain Buclaw <ibuclaw@gdcproject.org> 2019-08-11 Iain Buclaw <ibuclaw@gdcproject.org>
......
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment