Integrate mainline

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

diff --git a/t/TEST b/t/TEST
index 9dd34f3..e455043 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -9,6 +9,7 @@ $| = 1;
 if ($#ARGV >= 0) {
     foreach my $idx (0..$#ARGV) {
        next unless $ARGV[$idx] =~ /^-(\S+)$/;
+       $core    = 1 if $1 eq 'core';
        $verbose = 1 if $1 eq 'v';
        $with_utf= 1 if $1 eq 'utf8';
        if ($1 =~ /^deparse(,.+)?$/) {
@@ -24,7 +25,7 @@ chdir 't' if -f 't/TEST';
 die "You need to run \"make test\" first to set things up.\n"
   unless -e 'perl' or -e 'perl.exe';
 
-if ($ENV{PERL_3LOG}) {
+if ($ENV{PERL_3LOG}) { # Tru64 third(1) tool, see perlhack
     unless (-x 'perl.third') {
        unless (-x '../perl.third') {
            die "You need to run \"make perl.third first.\n";
@@ -44,7 +45,6 @@ $ENV{PERL_DESTRUCT_LEVEL} = 2 unless exists $ENV{PERL_DESTRUCT_LEVEL};
 
 $ENV{EMXSHELL} = 'sh';        # For OS/2
 
-
 # Roll your own File::Find!
 use TestInit;
 use File::Spec;
@@ -65,11 +65,29 @@ sub _find_tests {
 }
 
 unless (@ARGV) {
-    foreach my $dir (qw(base comp cmd run io op pragma lib pod)) {
+    foreach my $dir (qw(base comp cmd run io op)) {
         _find_tests($dir);
     }
+    _find_tests("lib") unless $core;
+    my $mani = File::Spec->catdir($updir, "MANIFEST");
+    if (open(MANI, $mani)) {
+        while (<MANI>) { # similar code in t/harness
+           if (m!^(ext/\S+/([^/]+\.t|test\.pl)|lib/\S+?(\.t|test\.pl))\s!) {
+               $t = $1;
+               if (!$core || $t =~ m!^lib/[a-z]!)
+               {
+                   push @ARGV, $t;
+                   $OVER{$t} = File::Spec->catdir($updir, $t);
+               }
+           }
+       }
+    } else {
+        warn "$0: cannot open $mani: $!\n";
+    }
+    _find_tests('pod');
 }
 
+# Tests known to cause infinite loops for the perlcc tests.
 # %infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
 %infinite = ();
 
@@ -84,17 +102,16 @@ sub _testprogs {
     $type = shift @_;
     @tests = @_;
 
-
     print <<'EOT' if ($type eq 'compile');
---------------------------------------------------------------------------------
+------------------------------------------------------------------------------
 TESTING COMPILER
---------------------------------------------------------------------------------
+------------------------------------------------------------------------------
 EOT
 
     print <<'EOT' if ($type eq 'deparse');
---------------------------------------------------------------------------------
+------------------------------------------------------------------------------
 TESTING DEPARSER
---------------------------------------------------------------------------------
+------------------------------------------------------------------------------
 EOT
 
     $ENV{PERLCC_TIMEOUT} = 120
@@ -105,14 +122,17 @@ EOT
     $total = @tests;
     $files  = 0;
     $totmax = 0;
-    $maxlen = 0;
-    foreach (@tests) {
-       $len = length;
-       $maxlen = $len if $len > $maxlen;
+    my $maxlen = 0;
+    my $maxsuflen = 0;
+    foreach (@tests) { # The same code in lib/Test/Harness.pm:_run_all_tests
+       my $suf    = /\.(\w+)$/ ? $1 : '';
+       my $len    = length;
+       my $suflen = length $suf;
+       $maxlen    = $len    if $len    > $maxlen;
+       $maxsuflen = $suflen if $suflen > $maxsuflen;
     }
-    # +3 : we want three dots between the test name and the "ok"
-    # -2 : the .t suffix
-    $dotdotdot = $maxlen + 3 - 2;
+    # + 3 : we want three dots between the test name and the "ok"
+    $dotdotdot = $maxlen + 3 - $maxsuflen;
     while ($test = shift @tests) {
 
        if ( $infinite{$test} && $type eq 'compile' ) {
@@ -133,9 +153,11 @@ EOT
            }
        }
        $te = $test;
-       chop($te);
+       $te =~ s/\.\w+$/./;
        print "$te" . '.' x ($dotdotdot - length($te));
 
+       $test = $OVER{$test} if exists $OVER{$test};
+
        open(SCRIPT,"<$test") or die "Can't run $test.\n";
        $_ = <SCRIPT>;
        close(SCRIPT) unless ($type eq 'deparse');
@@ -159,30 +181,31 @@ EOT
            }
            close(SCRIPT);
        }
-       my $utf = $with_utf ? '-I../lib -Mutf8'
-                           : '';
+
+       my $utf = $with_utf ? '-I../lib -Mutf8' : '';
        my $testswitch = '-I. -MTestInit'; # -T will strict . from @INC
        if ($type eq 'deparse') {
            my $deparse =
                "./perl $testswitch $switch -I../lib -MO=-qq,Deparse,".
                "-l$deparse_opts$file_opts ".
-               "./$test > ./$test.dp ".
-               "&& ./perl $testswitch $switch -I../lib ./$test.dp |";
+               "$test > $test.dp ".
+               "&& ./perl $testswitch $switch -I../lib $test.dp |";
            open(RESULTS, $deparse)
                or print "can't deparse '$deparse': $!.\n";
        }
        elsif ($type eq 'perl') {
-           my $run = "./perl $testswitch $switch $utf $test |";
+           my $perl = $ENV{PERL} || './perl';
+           my $run = "$perl $testswitch $switch $utf $test |";
            open(RESULTS,$run) or print "can't run '$run': $!.\n";
        }
        else {
            my $compile =
                "./perl $testswitch -I../lib ../utils/perlcc -o ".
-                "./$test.plc $utf ./$test ".
-               " && ./$test.plc |";
+                "$test.plc $utf $test ".
+               " && $test.plc |";
            open(RESULTS, $compile)
                or print "can't compile '$compile': $!.\n";
-           unlink "./$test.plc";
+           unlink "$test.plc";
        }
 
        $ok = 0;
@@ -201,7 +224,7 @@ EOT
                    $ok = 1;
                }
                else {
-                   if (/^(not )?ok (\d+)(\s*#.*)?/ &&
+                   if (/^(not )?ok (\d+)[^#]*(\s*#.*)?/ &&
                        $2 == $next)
                    {
                        my($not, $num, $extra) = ($1, $2, $3);
@@ -232,9 +255,11 @@ EOT
        }
        if ($ENV{PERL_3LOG}) {
            my $tpp = $test;
+           $tpp =~ s:^../::;
            $tpp =~ s:/:_:g;
            $tpp =~ s:\.t$::;
-           rename("perl.3log", "perl.3log.$tpp");
+           rename("perl.3log", "perl.3log.$tpp") ||
+               die "rename: perl3.log to perl.3log.$tpp: $!\n";
        }
        $next = $next - 1;
        if ($ok && $next == $max) {