Don’t taint return value of s///e based on replacement

According to the comments about how taint works above pp_subst in
pp_hot.c, the return value of s/// should not be tainted based on
the taintedness of the replacement.  That makes sense, because the
replacement does not affect how many iterations there were.  (The
return value is the number of iterations).

It only applies, however, to the cases where the ‘constant replace-
ment’ optimisation applies.

That means /e taints its return value:

$ perl5.16.0 -MDevel::Peek -Te '$_ = "abcd"; $x = s//$^X/; Dump $x'
SV = PVMG(0x822ff4) at 0x824dc0
  REFCNT = 1
  FLAGS = (pIOK)
  IV = 1
  NV = 0
  PV = 0
$ perl5.16.0 -MDevel::Peek -Te '$_ = "abcd"; $x = s//$^X/e; Dump $x'
SV = PVMG(0x823010) at 0x824dc0
  REFCNT = 1
  FLAGS = (GMG,SMG,pIOK)
  IV = 1
  NV = 0
  PV = 0
  MAGIC = 0x201940
    MG_VIRTUAL = &PL_vtbl_taint
    MG_TYPE = PERL_MAGIC_taint(t)
    MG_LEN = 1

The number pushed on to the stack was becoming tainted due to the set-
ting of PL_tainted.  PL_tainted is assigned to and the return value
explicitly tainted if appropriate shortly after the mPUSHi (which
implies sv_setiv, which taints when PL_tainted is true), so setting
PL_tainted to 0 just before the mPUSHi is safe.

diff --git a/pp_ctl.c b/pp_ctl.c
index 19c2417..23847c4 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -250,6 +250,7 @@ PP(pp_substcont)
                    SvUTF8_on(targ);
                SvPV_set(dstr, NULL);
 
+               PL_tainted = 0;
                mPUSHi(saviters - 1);
 
                (void)SvPOK_only_UTF8(targ);

diff --git a/t/op/taint.t b/t/op/taint.t
index 0e89c1f..d621de6 100644 (file)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -561,7 +561,7 @@ my $TEST = 'TEST';
        $one = $1;
     }
     is_tainted($s,     "$desc: s tainted");
-    is_tainted($res,   "$desc: res tainted");
+    isnt_tainted($res, "$desc: res tainted");
     isnt_tainted($one, "$desc: \$1 not tainted");
     is($s,  '123',     "$desc: s value");
     is($res, 3,        "$desc: res value");
@@ -918,7 +918,7 @@ my $TEST = 'TEST';
            $one = $1;
        }
        is_tainted($s,     "$desc: s tainted");
-       is_tainted($res,   "$desc: res tainted");
+       isnt_tainted($res, "$desc: res tainted");
        isnt_tainted($one, "$desc: \$1 not tainted");
        is($s,  '123',     "$desc: s value");
        is($res, 3,        "$desc: res value");