[perl #8698] format bug with undefined _TOP

[p5sagit/p5-mst-13.2.git] / t / TEST

diff --git a/t/TEST b/t/TEST
index 95869fb..7ff34b2 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -21,8 +21,9 @@ if ($#ARGV >= 0) {
        $verbose = 1 if $1 eq 'v';
        $torture = 1 if $1 eq 'torture';
        $with_utf= 1 if $1 eq 'utf8';
-        $bytecompile = 1 if $1 eq 'bytecompile';
-        $compile = 1 if $1 eq 'compile';
+       $bytecompile = 1 if $1 eq 'bytecompile';
+       $compile = 1 if $1 eq 'compile';
+       $taintwarn = 1 if $1 eq 'taintwarn';
        if ($1 =~ /^deparse(,.+)?$/) {
            $deparse = 1;
            $deparse_opts = $1;
@@ -220,7 +221,13 @@ EOT
            $switch = qq{"-$1"};
        }
        else {
-           $switch = '';
+           if ($taintwarn) {
+               # not all tests are expected to pass with this option
+               $switch = '"-t"';
+           }
+           else {
+               $switch = '';
+           }
        }
 
         my $test_executable; # for 'compile' tests
@@ -246,9 +253,17 @@ EOT
                or print "can't deparse '$deparse': $!.\n";
        }
        elsif ($type eq 'bytecompile') {
-           my $perl = $ENV{PERL} || './perl';
-           my $redir = ($^O eq 'VMS' ? '2>&1' : '');
-           my $bswitch = "-MO=Bytecode,-H,-TI,-s`pwd`/$test,";
+           my ($pwd, $null);
+            if( $^O eq 'MSWin32') {
+               $pwd = `cd`;
+               $null = 'nul';
+           } else {
+               $pwd = `pwd`;
+               $null = '/dev/null';
+           }
+           chomp $pwd;
+           my $perl = $ENV{PERL} || "$pwd/perl";
+           my $bswitch = "-MO=Bytecode,-H,-TI,-s$pwd/$test,";
            $bswitch .= "-TF$test.plc,"
                if $test =~ m(chdir|pod/|CGI/t/carp|lib/DB);
            $bswitch .= "-k,"
@@ -257,8 +272,8 @@ EOT
                if $test =~ m(op/getpid);
            my $bytecompile =
                "$perl $testswitch $switch -I../lib $bswitch". 
-               "-o$test.plc $test 2>/dev/null &&".
-               "$perl $testswitch $switch -I../lib $utf $test.plc $redir|";
+               "-o$test.plc $test 2>$null &&".
+               "$perl $testswitch $switch -I../lib $utf $test.plc |";
            open(RESULTS,$bytecompile)
                or print "can't byte-compile '$bytecompile': $!.\n";
        }
@@ -338,7 +353,7 @@ EOT
                        $seen_ok = 1;
                        if ($2 == $next) {
                            my($not, $num, $extra) = ($1, $2, $3);
-                           my($istodo) = $extra =~ /^\s*#\s*TODO/ if $extra;
+                           my($istodo) = $extra =~ /#\s*TODO/ if $extra;
                            $istodo = 1 if $todo{$num};
 
                            if( $not && !$istodo ) {