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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-31 Hristian Kirtchev <kirtc...@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.--- gcc/ada/exp_ch7.adb
+++ 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 =>
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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);
--- /dev/null
new file mode 100644
+++ 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;
--- /dev/null
new file mode 100644
+++ 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);
