summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2010-03-25 10:56:35 +0000
committerDavid Mitchell <davem@iabyn.com>2010-03-25 10:56:35 +0000
commit447ee1343739cf8e34c4ff1ba9b30eae75c3f1ab (patch)
treeb713c83f9510652e10e27b68b31c2a0d45e49149 /t
parentfd69380d5d5b95ef16e2521cf4251b34ee0ce151 (diff)
downloadperl-447ee1343739cf8e34c4ff1ba9b30eae75c3f1ab.tar.gz
RT #67962: $1 treated as tainted in untainted match
Fix the issue in the following: use re 'taint'; $tainted =~ /(...)/; # $1 now correctly tainted $untainted =~ s/(...)/$1/; # $untainted now incorrectly tainted The problem stems from when $1 is updated. pp_substcont, which is called after the replacement expression has been evaluated, checks the returned expression for taintedness, and if so, taints the variable being substituted. For a substitution like s/(...)/x$1/ this works fine: the expression "x".$1 causes $1's get magic to be called, which sets $1 based on the recent match, and is marked as not tainted. Thus the returned expression is untainted. In the variant s/(...)/$1/, the returned value on the stack is $1 itself, and its get magic hasn't been called yet. So it still has the tainted flag from the previous pattern. The solution is to mg_get the returned expression *before* testing for taintedness.
Diffstat (limited to 't')
-rw-r--r--t/op/taint.t18
1 files changed, 17 insertions, 1 deletions
diff --git a/t/op/taint.t b/t/op/taint.t
index f601552e28..e3a5712913 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ use Config;
use File::Spec::Functions;
BEGIN { require './test.pl'; }
-plan tests => 321;
+plan tests => 325;
$| = 1;
@@ -1380,6 +1380,22 @@ foreach my $ord (78, 163, 256) {
}
+# Bug RT #67962: old tainted $1 gets treated as tainted
+# in next untainted # match
+
+{
+ use re 'taint';
+ "abc".$TAINT =~ /(.*)/; # make $1 tainted
+ ok(tainted($1), '$1 should be tainted');
+
+ my $untainted = "abcdef";
+ ok(!tainted($untainted), '$untainted should be untainted');
+ $untainted =~ s/(abc)/$1/;
+ ok(!tainted($untainted), '$untainted should still be untainted');
+ $untainted =~ s/(abc)/x$1/;
+ ok(!tainted($untainted), '$untainted should yet still be untainted');
+}
+
# This may bomb out with the alarm signal so keep it last
SKIP: {