From 3c5d07ab057a1cbe23ca655d172bfb53581be960 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Thu, 31 May 2018 10:46:48 +0000 Subject: [PATCH] [Ada] Spurious tampering check failure This patch modifies the transient scope mechanism to create a scope when the condition of an iteration scheme returns a controlled result or involves the secondary stack. As a result, a while loop which iterates over a container properly manages the tampering bit at each iteration of the loop. 2018-05-31 Hristian Kirtchev gcc/ada/ * exp_ch7.adb (Find_Transient_Context): An iteration scheme is a valid boudary for a transient scope. gcc/testsuite/ * gnat.dg/tampering_check1.adb, gnat.dg/tampering_check1_ivectors.ads, gnat.dg/tampering_check1_trim.adb, gnat.dg/tampering_check1_trim.ads: New testcase. From-SVN: r261006 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_ch7.adb | 11 +++++------ gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gnat.dg/tampering_check1.adb | 15 +++++++++++++++ .../gnat.dg/tampering_check1_ivectors.ads | 4 ++++ gcc/testsuite/gnat.dg/tampering_check1_trim.adb | 9 +++++++++ gcc/testsuite/gnat.dg/tampering_check1_trim.ads | 4 ++++ 7 files changed, 48 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/tampering_check1.adb create mode 100644 gcc/testsuite/gnat.dg/tampering_check1_ivectors.ads create mode 100644 gcc/testsuite/gnat.dg/tampering_check1_trim.adb create mode 100644 gcc/testsuite/gnat.dg/tampering_check1_trim.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d3942fff0e6..c29524b684f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2018-05-31 Hristian Kirtchev + + * exp_ch7.adb (Find_Transient_Context): An iteration scheme is a valid + boudary for a transient scope. + 2018-05-31 Valentine Reboul * gnatvsn.ads: Rename "GPL" version to "Community". diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 8f510c60420..c3707bb2eb8 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4987,6 +4987,7 @@ package body Exp_Ch7 is | N_Entry_Body_Formal_Part | N_Exit_Statement | N_If_Statement + | N_Iteration_Scheme | N_Terminate_Alternative => pragma Assert (Present (Prev)); @@ -5058,13 +5059,11 @@ package body Exp_Ch7 is return Curr; end if; - -- An iteration scheme or an Ada 2012 iterator specification is - -- not a valid context because Analyze_Iteration_Scheme already - -- employs special processing for them. + -- An Ada 2012 iterator specification is not a valid context + -- because Analyze_Iterator_Specification already employs special + -- processing for it. - when N_Iteration_Scheme - | N_Iterator_Specification - => + when N_Iterator_Specification => return Empty; when N_Loop_Parameter_Specification => diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0c7a85d2f6c..82af0622dd7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-05-31 Hristian Kirtchev + + * gnat.dg/tampering_check1.adb, gnat.dg/tampering_check1_ivectors.ads, + gnat.dg/tampering_check1_trim.adb, gnat.dg/tampering_check1_trim.ads: + New testcase. + 2018-05-31 Eric Botcazou * gnat.dg/size_clause1.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/tampering_check1.adb b/gcc/testsuite/gnat.dg/tampering_check1.adb new file mode 100644 index 00000000000..3a5cb07127c --- /dev/null +++ b/gcc/testsuite/gnat.dg/tampering_check1.adb @@ -0,0 +1,15 @@ +-- { dg-do run } + +with Tampering_Check1_IVectors; use Tampering_Check1_IVectors; +with Tampering_Check1_Trim; + +procedure Tampering_Check1 is + V : Vector; + +begin + V.Append (-1); + V.Append (-2); + V.Append (-3); + + Tampering_Check1_Trim (V); +end Tampering_Check1; diff --git a/gcc/testsuite/gnat.dg/tampering_check1_ivectors.ads b/gcc/testsuite/gnat.dg/tampering_check1_ivectors.ads new file mode 100644 index 00000000000..1154e2e5acb --- /dev/null +++ b/gcc/testsuite/gnat.dg/tampering_check1_ivectors.ads @@ -0,0 +1,4 @@ +with Ada.Containers.Vectors; + +package Tampering_Check1_IVectors is new + Ada.Containers.Vectors (Positive, Integer); diff --git a/gcc/testsuite/gnat.dg/tampering_check1_trim.adb b/gcc/testsuite/gnat.dg/tampering_check1_trim.adb new file mode 100644 index 00000000000..baabc01094f --- /dev/null +++ b/gcc/testsuite/gnat.dg/tampering_check1_trim.adb @@ -0,0 +1,9 @@ +procedure Tampering_Check1_Trim + (V : in out Tampering_Check1_IVectors.Vector) is + use Tampering_Check1_IVectors; + +begin + while not Is_Empty (V) and then V (V.First) < 0 loop + V.Delete_First; + end loop; +end Tampering_Check1_Trim; diff --git a/gcc/testsuite/gnat.dg/tampering_check1_trim.ads b/gcc/testsuite/gnat.dg/tampering_check1_trim.ads new file mode 100644 index 00000000000..f0892b33782 --- /dev/null +++ b/gcc/testsuite/gnat.dg/tampering_check1_trim.ads @@ -0,0 +1,4 @@ +with Tampering_Check1_IVectors; + +procedure Tampering_Check1_Trim + (V : in out Tampering_Check1_IVectors.Vector); -- 2.30.2