From: Nicholas Clark Date: Wed, 3 Dec 2008 09:19:32 +0000 (+0000) Subject: Fix for tainting regression in a test of Text::Template spotted by X-Git-Tag: accepted/trunk/20130322.191538~12417 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=302c0c93356e52f02a8925ac90ae96bf8db31000;p=platform%2Fupstream%2Fperl.git Fix for tainting regression in a test of Text::Template spotted by Andreas' smoker. p4raw-id: //depot/perl@34987 --- diff --git a/scope.c b/scope.c index 1e06671..cad14de 100644 --- a/scope.c +++ b/scope.c @@ -648,6 +648,8 @@ Perl_leave_scope(pTHX_ I32 base) void* ptr; register char* str; I32 i; + /* Localise the effects of the TAINT_NOT inside the loop. */ + const bool was = PL_tainted; if (base < -1) Perl_croak(aTHX_ "panic: corrupt saved stack index"); @@ -1065,6 +1067,8 @@ Perl_leave_scope(pTHX_ I32 base) Perl_croak(aTHX_ "panic: leave_scope inconsistency"); } } + + PL_tainted = was; } void diff --git a/t/op/taint.t b/t/op/taint.t index 29fc436..2dc1bb9 100755 --- 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 => 271; +plan tests => 298; $| = 1; @@ -1267,6 +1267,42 @@ foreach my $ord (78, 163, 256) { ok(!tainted($b), "untainted complement"); } +{ + my @data = qw(bonk zam zlonk qunckkk); + # Clearly some sort of usenet bang-path + my $string = $TAINT . join "!", @data; + + ok(tainted($string), "tainted data"); + + my @got = split /!|,/, $string; + + # each @got would be useful here, but I want the test for earlier perls + for my $i (0 .. $#data) { + ok(tainted($got[$i]), "tainted result $i"); + is($got[$i], $data[$i], "correct content $i"); + } + + ok(tainted($string), "still tainted data"); + + my @got = split /[!,]/, $string; + + # each @got would be useful here, but I want the test for earlier perls + for my $i (0 .. $#data) { + ok(tainted($got[$i]), "tainted result $i"); + is($got[$i], $data[$i], "correct content $i"); + } + + ok(tainted($string), "still tainted data"); + + my @got = split /!/, $string; + + # each @got would be useful here, but I want the test for earlier perls + for my $i (0 .. $#data) { + ok(tainted($got[$i]), "tainted result $i"); + is($got[$i], $data[$i], "correct content $i"); + } +} + # This may bomb out with the alarm signal so keep it last SKIP: { skip "No alarm()" unless $Config{d_alarm};