Re: Perl bug with "delete" on arrays

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

diff --git a/t/TEST b/t/TEST
index 5cd1927..0a63f0e 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -64,13 +64,13 @@ 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 lib)) {
         _find_tests($dir);
     }
     my $mani = File::Spec->catdir($updir, "MANIFEST");
     if (open(MANI, $mani)) {
-        while (<MANI>) {
-           if (m!^((?:ext|lib)/.+/(?:t/.+\.t)|test.pl)\s!) {
+        while (<MANI>) { # similar code in t/harness
+           if (m!^(ext/\S+/([^/]+\.t|test\.pl)|lib/\S+?(\.t|test\.pl))\s!) {
                push @ARGV, $1;
                $OVER{$1} = File::Spec->catdir($updir, $1);
            }
@@ -78,6 +78,7 @@ unless (@ARGV) {
     } else {
         warn "$0: cannot open $mani: $!\n";
     }
+    _find_tests('pod');
 }
 
 # Tests known to cause infinite loops for the perlcc tests.
@@ -115,14 +116,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' ) {
@@ -143,7 +147,7 @@ EOT
            }
        }
        $te = $test;
-       chop($te);
+       $te =~ s/\.\w+$/./;
        print "$te" . '.' x ($dotdotdot - length($te));
 
        $test = $OVER{$test} if exists $OVER{$test};
@@ -186,7 +190,8 @@ EOT
                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 {
@@ -246,9 +251,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) {