rpms
/
perl
21
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'i8c-stream-5.24'
${ noResults }
perl/SOURCES/perl-5.24.3-fix-tainting-of...

595 lines
20 KiB
Raw Permalink Blame History

From a56b6643ac9d2bae70dc93d49a08ba1eafa62c30 Mon Sep 17 00:00:00 2001
From: Zefram <zefram@fysh.org>
Date: Sun, 19 Nov 2017 09:15:53 +0000
Subject: [PATCH] fix tainting of s/// with overloaded replacement
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The substitution code was trying to track the taintedness of the
replacement string itself, but it didn't account for the replacement
being an untainted object with overloading that returns a tainted
stringification. It looked at the taintedness of the object value, not
realising that taint could arise during the string concatenation per se.
Change the taint checks to look at the actual TAINT_get flag after string
concatenation. This may falsely ascribe to the replacement taint that
actually came from somewhere else, but the end result is the same anyway:
there's no visible behaviour that distinguishes taint specifically from
the replacement. Also remove a related taint check that seems to be
not needed at all. Fixes [perl #115266].
Petr Písař: Ported to 5.24.3.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pp_ctl.c | 4 +-
pp_hot.c | 4 +-
t/op/taint.t | 429 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
3 files changed, 423 insertions(+), 14 deletions(-)
diff --git a/pp_ctl.c b/pp_ctl.c
index 9150142..97a4607 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -218,9 +218,9 @@ PP(pp_substcont)
SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */
/* See "how taint works" above pp_subst() */
- if (SvTAINTED(TOPs))
- cx->sb_rxtainted |= SUBST_TAINT_REPL;
sv_catsv_nomg(dstr, POPs);
+ if (UNLIKELY(TAINT_get))
+ cx->sb_rxtainted |= SUBST_TAINT_REPL;
if (CxONCE(cx) || s < orig ||
!CALLREGEXEC(rx, s, cx->sb_strend, orig,
(s == m), cx->sb_targ, NULL,
diff --git a/pp_hot.c b/pp_hot.c
index 243f43a..e80d991 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3004,7 +3004,7 @@ PP(pp_subst)
doutf8 = DO_UTF8(dstr);
}
- if (SvTAINTED(dstr))
+ if (UNLIKELY(TAINT_get))
rxtainted |= SUBST_TAINT_REPL;
}
else {
@@ -3181,8 +3181,6 @@ PP(pp_subst)
sv_catsv(dstr, nsv);
}
else sv_catsv(dstr, repl);
- if (UNLIKELY(SvTAINTED(repl)))
- rxtainted |= SUBST_TAINT_REPL;
}
if (once)
break;
diff --git a/t/op/taint.t b/t/op/taint.t
index 846ac23..dbcc418 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ BEGIN {
use strict;
use Config;
-plan tests => 812;
+plan tests => 1024;
$| = 1;
@@ -83,6 +83,8 @@ EndOfCleanup
# Sources of taint:
# The empty tainted value, for tainting strings
my $TAINT = substr($^X, 0, 0);
+# A tainted non-empty string
+my $TAINTXYZ = "xyz".$TAINT;
# A tainted zero, useful for tainting numbers
my $TAINT0;
{
@@ -565,7 +567,7 @@ my $TEST = 'TEST';
is($one, 'abcd', "$desc: \$1 value");
}
- $desc = "substitution with replacement tainted";
+ $desc = "substitution with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.+)/xyz$TAINT/;
@@ -577,7 +579,7 @@ my $TEST = 'TEST';
is($res, 1, "$desc: res value");
is($one, 'abcd', "$desc: \$1 value");
- $desc = "substitution /g with replacement tainted";
+ $desc = "substitution /g with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.)/x$TAINT/g;
@@ -589,7 +591,7 @@ my $TEST = 'TEST';
is($res, 4, "$desc: res value");
is($one, 'd', "$desc: \$1 value");
- $desc = "substitution /ge with replacement tainted";
+ $desc = "substitution /ge with partial replacement tainted";
$s = 'abc';
{
@@ -618,7 +620,7 @@ my $TEST = 'TEST';
is($res, 3, "$desc: res value");
is($one, 'c', "$desc: \$1 value");
- $desc = "substitution /r with replacement tainted";
+ $desc = "substitution /r with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.+)/xyz$TAINT/r;
@@ -630,6 +632,71 @@ my $TEST = 'TEST';
is($res, 'xyz', "$desc: res value");
is($one, 'abcd', "$desc: \$1 value");
+ $desc = "substitution with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$TAINTXYZ/;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /g with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$TAINTXYZ/g;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /ge with whole replacement tainted";
+
+ $s = 'abc';
+ {
+ my $i = 0;
+ my $j;
+ $res = $s =~ s{(.)}{
+ $j = $i; # make sure code not tainted
+ $one = $1;
+ isnt_tainted($j, "$desc: code not tainted within /e");
+ $i++;
+ if ($i == 1) {
+ isnt_tainted($s, "$desc: s not tainted loop 1");
+ }
+ else {
+ is_tainted($s, "$desc: s tainted loop $i");
+ }
+ isnt_tainted($one, "$desc: \$1 not tainted within /e");
+ $TAINTXYZ;
+ }ge;
+ $one = $1;
+ }
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz' x 3, "$desc: s value");
+ is($res, 3, "$desc: res value");
+ is($one, 'c', "$desc: \$1 value");
+
+ $desc = "substitution /r with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$TAINTXYZ/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ is_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'xyz', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
{
# now do them all again with "use re 'taint"
@@ -955,7 +1022,7 @@ my $TEST = 'TEST';
is($one, 'abcd', "$desc: \$1 value");
}
- $desc = "use re 'taint': substitution with replacement tainted";
+ $desc = "use re 'taint': substitution with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.+)/xyz$TAINT/;
@@ -967,7 +1034,7 @@ my $TEST = 'TEST';
is($res, 1, "$desc: res value");
is($one, 'abcd', "$desc: \$1 value");
- $desc = "use re 'taint': substitution /g with replacement tainted";
+ $desc = "use re 'taint': substitution /g with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.)/x$TAINT/g;
@@ -979,7 +1046,7 @@ my $TEST = 'TEST';
is($res, 4, "$desc: res value");
is($one, 'd', "$desc: \$1 value");
- $desc = "use re 'taint': substitution /ge with replacement tainted";
+ $desc = "use re 'taint': substitution /ge with partial replacement tainted";
$s = 'abc';
{
@@ -1008,7 +1075,7 @@ my $TEST = 'TEST';
is($res, 3, "$desc: res value");
is($one, 'c', "$desc: \$1 value");
- $desc = "use re 'taint': substitution /r with replacement tainted";
+ $desc = "use re 'taint': substitution /r with partial replacement tainted";
$s = 'abcd';
$res = $s =~ s/(.+)/xyz$TAINT/r;
@@ -1020,6 +1087,71 @@ my $TEST = 'TEST';
is($res, 'xyz', "$desc: res value");
is($one, 'abcd', "$desc: \$1 value");
+ $desc = "use re 'taint': substitution with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$TAINTXYZ/;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "use re 'taint': substitution /g with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$TAINTXYZ/g;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "use re 'taint': substitution /ge with whole replacement tainted";
+
+ $s = 'abc';
+ {
+ my $i = 0;
+ my $j;
+ $res = $s =~ s{(.)}{
+ $j = $i; # make sure code not tainted
+ $one = $1;
+ isnt_tainted($j, "$desc: code not tainted within /e");
+ $i++;
+ if ($i == 1) {
+ isnt_tainted($s, "$desc: s not tainted loop 1");
+ }
+ else {
+ is_tainted($s, "$desc: s tainted loop $i");
+ }
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ $TAINTXYZ;
+ }ge;
+ $one = $1;
+ }
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyz' x 3, "$desc: s value");
+ is($res, 3, "$desc: res value");
+ is($one, 'c', "$desc: \$1 value");
+
+ $desc = "use re 'taint': substitution /r with whole replacement tainted";
+
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$TAINTXYZ/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ is_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'xyz', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
# [perl #121854] match taintedness became sticky
# when one match has a taintess result, subseqent matches
# using the same pattern shouldn't necessarily be tainted
@@ -2408,6 +2540,285 @@ is eval { eval $::x.1 }, 1, 'reset does not taint undef';
}
+# taint passing through overloading
+package OvTaint {
+ sub new { bless({ t => $_[1] }, $_[0]) }
+ use overload '""' => sub { $_[0]->{t} ? "hi".$TAINT : "hello" };
+}
+my $ovclean = OvTaint->new(0);
+my $ovtaint = OvTaint->new(1);
+isnt_tainted("$ovclean", "overload preserves cleanliness");
+is_tainted("$ovtaint", "overload preserves taint");
+
+# substitutions with overloaded replacement
+{
+ my ($desc, $s, $res, $one);
+
+ $desc = "substitution with partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/xyz$ovclean/;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution with partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/xyz$ovtaint/;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution with whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovclean/;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution with whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovtaint/;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/"xyz".$ovclean/e;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/"xyz".$ovtaint/e;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovclean/e;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovtaint/e;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with extra code and partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/(my $z++), "xyz".$ovclean/e;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with extra code and partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/(my $z++), "xyz".$ovtaint/e;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xyzhi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with extra code and whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/(my $z++), $ovclean/e;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hello', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /e with extra code and whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/(my $z++), $ovtaint/e;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hi', "$desc: s value");
+ is($res, 1, "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /r with partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/xyz$ovclean/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'xyzhello', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /r with partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/xyz$ovtaint/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ is_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'xyzhi', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /r with whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovclean/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'hello', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /r with whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.+)/$ovtaint/r;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ is_tainted($res, "$desc: res tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'abcd', "$desc: s value");
+ is($res, 'hi', "$desc: res value");
+ is($one, 'abcd', "$desc: \$1 value");
+
+ $desc = "substitution /g with partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/x$ovclean/g;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xhello' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /g with partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/x$ovtaint/g;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xhi' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /g with whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$ovclean/g;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hello' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /g with whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$ovtaint/g;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hi' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /ge with partial replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/"x".$ovclean/ge;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xhello' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /ge with partial replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/"x".$ovtaint/ge;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'xhi' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /ge with whole replacement overloaded and clean";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$ovclean/ge;
+ $one = $1;
+ isnt_tainted($s, "$desc: s not tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hello' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+
+ $desc = "substitution /ge with whole replacement overloaded and tainted";
+ $s = 'abcd';
+ $res = $s =~ s/(.)/$ovtaint/ge;
+ $one = $1;
+ is_tainted($s, "$desc: s tainted");
+ isnt_tainted($res, "$desc: res not tainted");
+ isnt_tainted($one, "$desc: \$1 not tainted");
+ is($s, 'hi' x 4, "$desc: s value");
+ is($res, 4, "$desc: res value");
+ is($one, 'd', "$desc: \$1 value");
+}
+
# This may bomb out with the alarm signal so keep it last
SKIP: {
skip "No alarm()" unless $Config{d_alarm};
--
2.13.6
Reference in new issue View Git Blame Copy Permalink