X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Ftaint.t;h=b4c8bfea53ff5e05cb7c3e5434b072fa0f35f8e2;hb=3e6bd4bfcd175c613d32ccb2eb2fde8ff580206a;hp=2dc1bb9883eaf0c45017efe3d81270b19c1af9dc;hpb=302c0c93356e52f02a8925ac90ae96bf8db31000;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/taint.t b/t/op/taint.t
old mode 100755
new mode 100644
index 2dc1bb9..b4c8bfe
--- 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 => 298;
+plan tests => 319;
 
 $| = 1;
 
@@ -42,7 +42,6 @@ BEGIN {
   }
 }
 
-my $Is_MacOS    = $^O eq 'MacOS';
 my $Is_VMS      = $^O eq 'VMS';
 my $Is_MSWin32  = $^O eq 'MSWin32';
 my $Is_NetWare  = $^O eq 'NetWare';
@@ -51,8 +50,7 @@ my $Is_Cygwin   = $^O eq 'cygwin';
 my $Is_OpenBSD  = $^O eq 'openbsd';
 my $Invoke_Perl = $Is_VMS      ? 'MCR Sys$Disk:[]Perl.exe' :
                   $Is_MSWin32  ? '.\perl'               :
-                  $Is_MacOS    ? ':perl'                :
-                  $Is_NetWare  ? 'perl'                 : 
+                  $Is_NetWare  ? 'perl'                 :
                                  './perl'               ;
 my @MoreEnv = qw/IFS CDPATH ENV BASH_ENV/;
 
@@ -134,7 +132,7 @@ sub test ($;$) {
 }
 
 # We need an external program to call.
-my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : $Is_MacOS ? ":echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));
+my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));
 END { unlink $ECHO }
 open PROG, "> $ECHO" or die "Can't create $ECHO: $!";
 print PROG 'print "@ARGV\n"', "\n";
@@ -173,7 +171,7 @@ my $TEST = catfile(curdir(), 'TEST');
 
     SKIP: {
         skip "Environment tainting tests skipped", 4
-          if $Is_MSWin32 || $Is_NetWare || $Is_VMS || $Is_Dos || $Is_MacOS;
+          if $Is_MSWin32 || $Is_NetWare || $Is_VMS || $Is_Dos;
 
 	my @vars = ('PATH', @MoreEnv);
 	while (my $v = $vars[0]) {
@@ -285,7 +283,7 @@ my $TEST = catfile(curdir(), 'TEST');
 # 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 };
@@ -430,8 +428,7 @@ SKIP: {
     # just because Errno possibly failing.
     test eval('$!{ENOENT}') ||
 	$! == 2 || # File not found
-	($Is_Dos && $! == 22) ||
-	($^O eq 'mint' && $! == 33);
+	($Is_Dos && $! == 22);
 
     test !eval { open FOO, "> $foo" }, 'open for write';
     test $@ =~ /^Insecure dependency/, $@;
@@ -628,7 +625,6 @@ SKIP: {
 	unlink($symlink);
 	my $sl = "/something/naughty";
 	# it has to be a real path on Mac OS
-	$sl = MacPerl::MakePath((MacPerl::Volumes())[0]) if $Is_MacOS;
 	symlink($sl, $symlink) or die "symlink: $!\n";
 	my $readlink = readlink($symlink);
 	test tainted $readlink;
@@ -973,15 +969,11 @@ TODO: {
     };
     test !$@;
 
-    SKIP: {
-        skip "no exec() on MacOS Classic" if $Is_MacOS;
-
-	eval { 
-            no warnings;
-            exec("lskdfj does not exist","with","args"); 
-        };
-	test !$@;
-    }
+    eval {
+	no warnings;
+	exec("lskdfj does not exist","with","args"); 
+    };
+    test !$@;
 
     # If you add tests here update also the above skip block for VMS.
 }
@@ -1303,6 +1295,86 @@ foreach my $ord (78, 163, 256) {
     }
 }
 
+# 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");
+}
+
+# Bug RT #61976 tainted $! would show numeric rather than string value
+
+{
+    my $tainted_path = substr($^X,0,0) . "/no/such/file";
+    my $err;
+    # $! is used in a tainted expression, so gets tainted
+    open my $fh, $tainted_path or $err= "$!";
+    unlike($err, qr/^\d+$/, 'tainted $!');
+}
+
+{
+    # #6758: tainted values become untainted in tied hashes
+    #         (also applies to other value magic such as pos)
+
+
+    package P6758;
+
+    sub TIEHASH { bless {} }
+    sub TIEARRAY { bless {} }
+
+    my $i = 0;
+
+    sub STORE {
+	main::ok(main::tainted($_[1]), "tied arg1 tainted");
+	main::ok(main::tainted($_[2]), "tied arg2 tainted");
+        $i++;
+    }
+
+    package main;
+
+    my ($k,$v) = qw(1111 val);
+    taint_these($k,$v);
+    tie my @array, 'P6758';
+    tie my %hash , 'P6758';
+    $array[$k] = $v;
+    $hash{$k} = $v;
+    ok $i == 2, "tied STORE called correct number of times";
+}
+
+# Bug RT #45167 the return value of sprintf sometimes wasn't tainted
+# when the args were tainted. This only occured on the first use of
+# sprintf; after that, its TARG has taint magic attached, so setmagic
+# at the end works.  That's why there are multiple sprintf's below, rather
+# than just one wrapped in an inner loop. Also, any plantext betwerrn
+# fprmat entires would correctly cause tainting to get set. so test with
+# "%s%s" rather than eg "%s %s".
+
+{
+    for my $var1 ($TAINT, "123") {
+	for my $var2 ($TAINT0, "456") {
+	    my @s;
+	    push @s, sprintf '%s', $var1, $var2;
+	    push @s, sprintf ' %s', $var1, $var2;
+	    push @s, sprintf '%s%s', $var1, $var2;
+	    for (0..2) {
+		ok( !(
+			tainted($s[$_]) xor
+			(tainted($var1) || ($_==2 && tainted($var2)))
+		    ),
+		    "sprintf fmt$_, '$var1', '$var2'");
+	    }
+	}
+    }
+}
+
+
+
 # This may bomb out with the alarm signal so keep it last
 SKIP: {
     skip "No alarm()"  unless $Config{d_alarm};