Re: overriding builtins quirk
[p5sagit/p5-mst-13.2.git] / t / op / taint.t
index bbe643c..686354e 100755 (executable)
@@ -124,7 +124,7 @@ my $echo = "$Invoke_Perl $ECHO";
 
 my $TEST = catfile(curdir(), 'TEST');
 
-print "1..203\n";
+print "1..206\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -452,7 +452,7 @@ else {
        test 87, $@ eq '', $@;
     }
     else {
-       for (86..87) { print "ok $_ # Skipped: this is not VMS\n"; }
+       for (86..87) { print "ok $_ # Skipped: This is not VMS\n"; }
     }
 }
 
@@ -894,8 +894,8 @@ else {
     my @untainted;
     while (my ($k, $v) = each %ENV) {
        if (!tainted($v) &&
-           # These we have untainted explicitly earlier.
-           $k !~ /^(BASH_ENV|CDPATH|ENV|IFS|PATH|TEMP|TERM|TMP)$/) {
+           # These we have explicitly untainted or set earlier.
+           $k !~ /^(BASH_ENV|CDPATH|ENV|IFS|PATH|PERL_CORE|TEMP|TERM|TMP)$/) {
            push @untainted, "# '$k' = '$v'\n";
        }
     }
@@ -904,7 +904,7 @@ else {
 }
 
 
-ok( ${^TAINT},  '$^TAINT is on' );
+ok( ${^TAINT} == 1, '$^TAINT is on' );
 
 eval { ${^TAINT} = 0 };
 ok( ${^TAINT},  '$^TAINT is not assignable' );
@@ -935,15 +935,13 @@ else
     test 183, $@ =~ /^Insecure \$ENV/;
 }
 if ($Is_VMS) {
-    for (184..203) {print "not ok $_ # TODO tainted %ENV warning occludes tainted arguments warning\n";}
+    for (184..205) {print "not ok $_ # TODO tainted %ENV warning occludes tainted arguments warning\n";}
 }
 else 
 {
     # bug 20020208.005 plus some extras
     # single arg exec/system are tests 80-83
-    use if $] lt '5.009', warnings => FATAL => 'taint';
-    my $err = $] ge '5.009' ? qr/^Insecure dependency/ 
-                            : qr/^Use of tainted arguments/;
+    my $err = qr/^Insecure dependency/ ;
     test 184, eval { exec $TAINT, $TAINT } eq '', 'exec';
     test 185, $@ =~ $err, $@;
     test 186, eval { exec $TAINT $TAINT } eq '', 'exec';
@@ -957,12 +955,26 @@ else
 
     test 194, eval { system $TAINT, $TAINT } eq '', 'system';
     test 195, $@ =~ $err, $@;
-    test 196, eval { system $TAINT $TAINT } eq '', 'exec';
+    test 196, eval { system $TAINT $TAINT } eq '', 'system';
     test 197, $@ =~ $err, $@;
-    test 198, eval { system $TAINT $TAINT, $TAINT } eq '', 'exec';
+    test 198, eval { system $TAINT $TAINT, $TAINT } eq '', 'system';
     test 199, $@ =~ $err, $@;
-    test 200, eval { system $TAINT 'notaint' } eq '', 'exec';
+    test 200, eval { system $TAINT 'notaint' } eq '', 'system';
     test 201, $@ =~ $err, $@;
-    test 202, eval { system {'notaint'} $TAINT } eq '', 'exec';
+    test 202, eval { system {'notaint'} $TAINT } eq '', 'system';
     test 203, $@ =~ $err, $@;
+
+    eval { system("lskdfj does not exist","with","args"); };
+    test 204, $@ eq '';
+    eval { exec("lskdfj does not exist","with","args"); };
+    test 205, $@ eq '';
+
+    # If you add tests here update also the above skip block for VMS.
+}
+
+{
+    # [ID 20020704.001] taint propagation failure
+    use re 'taint';
+    $TAINT =~ /(.*)/;
+    test 206, tainted(my $foo = $1);
 }