[perl #32039] Chained goto &sub drops data too early.

[p5sagit/p5-mst-13.2.git] / t / op / taint.t

diff --git a/t/op/taint.t b/t/op/taint.t
index 846e1fd..2204632 100755 (executable)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -16,6 +16,7 @@ use strict;
 use Config;
 use File::Spec::Functions;
 
+my $total_tests = 236;
 my $test = 177;
 sub ok ($;$) {
     my($ok, $name) = @_;
@@ -44,7 +45,7 @@ BEGIN {
       eval { require IPC::SysV };
       unless ($@) {
          $ipcsysv++;
-         IPC::SysV->import(qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU));
+         IPC::SysV->import(qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU IPC_NOWAIT));
       }
   }
 }
@@ -124,7 +125,7 @@ my $echo = "$Invoke_Perl $ECHO";
 
 my $TEST = catfile(curdir(), 'TEST');
 
-print "1..206\n";
+print "1..$total_tests\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -139,7 +140,17 @@ print "1..206\n";
     if ($Is_Cygwin && ! -f 'cygwin1.dll') {
        system("/usr/bin/cp /usr/bin/cygwin1.dll .") &&
            die "$0: failed to cp cygwin1.dll: $!\n";
-       END { unlink "cygwin1.dll" } # yes, done for all platforms...
+       eval q{
+           END { unlink "cygwin1.dll" }
+       };
+    }
+
+    if ($Is_Cygwin && ! -f 'cygcrypt-0.dll' && -f '/usr/bin/cygcrypt-0.dll') {
+       system("/usr/bin/cp /usr/bin/cygcrypt-0.dll .") &&
+           die "$0: failed to cp cygcrypt-0.dll: $!\n";
+       eval q{
+           END { unlink "cygcrypt-0.dll" }
+       };
     }
 
     test 1, eval { `$echo 1` } eq "1\n";
@@ -700,14 +711,14 @@ else {
        my $type_rcvd;
 
        if (defined $id) {
-           if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
-               if (msgrcv($id, $rcvd, 60, 0, 0)) {
+           if (msgsnd($id, pack("l! a*", $type_sent, $sent), IPC_NOWAIT)) {
+               if (msgrcv($id, $rcvd, 60, 0, IPC_NOWAIT)) {
                    ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
                } else {
-                   warn "# msgrcv failed\n";
+                   warn "# msgrcv failed: $!\n";
                }
            } else {
-               warn "# msgsnd failed\n";
+               warn "# msgsnd failed: $!\n";
            }
            msgctl($id, IPC_RMID, 0) or warn "# msgctl failed: $!\n";
        } else {
@@ -982,3 +993,92 @@ else
     $TAINT =~ /(.*)/;
     test 206, tainted(my $foo = $1);
 }
+
+{
+    # [perl #24291] this used to dump core
+    our %nonmagicalenv = ( PATH => "util" );
+    local *ENV = \%nonmagicalenv;
+    eval { system("lskdfj"); };
+    test 207, $@ =~ /^%ENV is aliased to another variable while running with -T switch/;
+    local *ENV = *nonmagicalenv;
+    eval { system("lskdfj"); };
+    test 208, $@ =~ /^%ENV is aliased to %nonmagicalenv while running with -T switch/;
+}
+{
+    # [perl #24248]
+    $TAINT =~ /(.*)/;
+    test 209, !tainted($1);
+    my $notaint = $1;
+    test 210, !tainted($notaint);
+
+    my $l;
+    $notaint =~ /($notaint)/;
+    $l = $1;
+    test 211, !tainted($1);
+    test 212, !tainted($l);
+    $notaint =~ /($TAINT)/;
+    $l = $1;
+    test 213, tainted($1);
+    test 214, tainted($l);
+
+    $TAINT =~ /($notaint)/;
+    $l = $1;
+    test 215, !tainted($1);
+    test 216, !tainted($l);
+    $TAINT =~ /($TAINT)/;
+    $l = $1;
+    test 217, tainted($1);
+    test 218, tainted($l);
+
+    my $r;
+    ($r = $TAINT) =~ /($notaint)/;
+    test 219, !tainted($1);
+    ($r = $TAINT) =~ /($TAINT)/;
+    test 220, tainted($1);
+
+    #  [perl #24674]
+    # accessing $^O  shoudn't taint it as a side-effect;
+    # assigning tainted data to it is now an error
+
+    test 221, !tainted($^O);
+    if (!$^X) { } elsif ($^O eq 'bar') { }
+    test 222, !tainted($^O);
+    eval '$^O = $^X';
+    test 223, $@ =~ /Insecure dependency in/;
+}
+
+EFFECTIVELY_CONSTANTS: {
+    my $tainted_number = 12 + $TAINT0;
+    test 224, tainted( $tainted_number );
+
+    # Even though it's always 0, it's still tainted
+    my $tainted_product = $tainted_number * 0;
+    test 225, tainted( $tainted_product );
+    test 226, $tainted_product == 0;
+}
+
+TERNARY_CONDITIONALS: {
+    my $tainted_true  = $TAINT . "blah blah blah";
+    my $tainted_false = $TAINT0;
+    test 227, tainted( $tainted_true );
+    test 228, tainted( $tainted_false );
+
+    my $result = $tainted_true ? "True" : "False";
+    test 229, $result eq "True";
+    test 230, !tainted( $result );
+
+    $result = $tainted_false ? "True" : "False";
+    test 231, $result eq "False";
+    test 232, !tainted( $result );
+
+    my $untainted_whatever = "The Fabulous Johnny Cash";
+    my $tainted_whatever = "Soft Cell" . $TAINT;
+
+    $result = $tainted_true ? $tainted_whatever : $untainted_whatever;
+    test 233, $result eq "Soft Cell";
+    test 234, tainted( $result );
+
+    $result = $tainted_false ? $tainted_whatever : $untainted_whatever;
+    test 235, $result eq "The Fabulous Johnny Cash";
+    test 236, !tainted( $result );
+}