[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  <kirtchev@adacore.com>

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d3942fff0e685d3dd7c3e7b1cf59e91bf384fa0a..c29524b684fdc73094140c95ec23ae36962fa9c0 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2018-05-31  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_ch7.adb (Find_Transient_Context): An iteration scheme is a valid
+       boudary for a transient scope.
+
 2018-05-31  Valentine Reboul  <reboul@adacore.com>
 
        * gnatvsn.ads: Rename "GPL" version to "Community".

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 8f510c6042019ce0cf03d7745ae68a49f729f4a0..c3707bb2eb8224d9558d5f9a01b23ba2a8f7c727 100644 (file)
--- 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 0c7a85d2f6c44bef3ae091c25eff1c2d7a2b3348..82af0622dd7494b4724729fed68cdf6eaaa286d3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2018-05-31  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * 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  <ebotcazou@adacore.com>
 
        * 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 (file)
index 0000000..3a5cb07
--- /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 (file)
index 0000000..1154e2e
--- /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 (file)
index 0000000..baabc01
--- /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 (file)
index 0000000..f0892b3
--- /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);