[perl.git] branch davem/post-5.12, updated. v5.11.5-133-g447ee13

[Dave Mitchell]

In perl.git, the branch davem/post-5.12 has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/447ee1343739cf8e34c4ff1ba9b30eae75c3f1ab?hp=fd69380d5d5b95ef16e2521cf4251b34ee0ce151>

- Log -----------------------------------------------------------------
commit 447ee1343739cf8e34c4ff1ba9b30eae75c3f1ab
Author: David Mitchell <da...@iabyn.com>
Date:   Thu Mar 25 10:56:35 2010 +0000

    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.
-----------------------------------------------------------------------

Summary of changes:
 pp_ctl.c     |    4 +++-
 t/op/taint.t |   18 +++++++++++++++++-
 2 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index de34879..a35cd43 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -278,9 +278,11 @@ PP(pp_substcont)
        if (cx->sb_iters > cx->sb_maxiters)
            DIE(aTHX_ "Substitution loop");
 
+       SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */
+
        if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
            cx->sb_rxtainted |= 2;
-       sv_catsv(dstr, POPs);
+       sv_catsv_nomg(dstr, POPs);
        /* XXX: adjust for positive offsets of \G for instance s/(.)\G//g with 
positive pos() */
        s -= RX_GOFS(rx);
 
diff --git a/t/op/taint.t b/t/op/taint.t
index f601552..e3a5712 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: {

--
Perl5 Master Repository