use File::Spec::Functions;
BEGIN { require './test.pl'; }
-plan tests => 267;
+plan tests => 301;
$| = 1;
# How about command-line arguments? The problem is that we don't
# always get some, so we'll run another process with some.
SKIP: {
- my $arg = catfile(curdir(), tempfile());
+ my $arg = tempfile();
open PROG, "> $arg" or die "Can't create $arg: $!";
print PROG q{
eval { join('', @ARGV), kill 0 };
ok(!tainted($1), "\\S match with chr $ord");
}
+{
+ # 59998
+ sub cr { my $x = crypt($_[0], $_[1]); $x }
+ sub co { my $x = ~$_[0]; $x }
+ my ($a, $b);
+ $a = cr('hello', 'foo' . $TAINT);
+ $b = cr('hello', 'foo');
+ ok(tainted($a), "tainted crypt");
+ ok(!tainted($b), "untainted crypt");
+ $a = co('foo' . $TAINT);
+ $b = co('foo');
+ ok(tainted($a), "tainted complement");
+ 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");
+ }
+}
+
+# Bug RT #52552 - broken by change at git commit id f337b08
+{
+ my $x = $TAINT. q{print "Hello world\n"};
+ my $y = pack "a*", $x;
+ ok(tainted($y), "pack a* preserves tainting");
+
+ my $z = pack "A*", q{print "Hello world\n"}.$TAINT;
+ ok(tainted($z), "pack A* preserves tainting");
+
+ my $zz = pack "a*a*", q{print "Hello world\n"}, $TAINT;
+ ok(tainted($zz), "pack a*a* preserves tainting");
+}
+
# This may bomb out with the alarm signal so keep it last
SKIP: {
skip "No alarm()" unless $Config{d_alarm};