perlutil updates and cleanup

[perl5.git] / t / harness

diff --git a/t/harness b/t/harness
index 30f4b1a..58a212f 100644 (file)
--- a/t/harness
+++ b/t/harness
@@ -34,27 +34,7 @@ if ($ARGV[0] && $ARGV[0] eq '-torture') {
 # which live dual lives on CPAN.
 $ENV{PERL_CORE} = 1;
 
-#fudge DATA for now.
-my %datahandle = qw(
-               lib/bigint.t            1
-               lib/bigintpm.t          1
-               lib/bigfloat.t          1
-               lib/bigfloatpm.t        1
-               op/gv.t                 1
-               lib/complex.t           1
-               lib/ph.t                1
-               lib/soundex.t           1
-               op/misc.t               1
-               op/runlevel.t           1
-               op/tie.t                1
-               op/lex_assign.t         1
-               );
-
-foreach (keys %datahandle) {
-     unlink "$_.t";
-}
-
-my (@tests, $re);
+my (@tests, @re, @anti_re);
 
 # [.VMS]TEST.COM calls harness with empty arguments, so clean-up @ARGV
 @ARGV = grep $_ && length( $_ ) => @ARGV;
@@ -81,13 +61,16 @@ sub _extract_tests {
     @results;
 }
 
-if ($ARGV[0] && $ARGV[0]=~/^-re/) {
-    if ($ARGV[0]!~/=/) {
-        shift;
-        $re=join "|",@ARGV;
-        @ARGV=();
+while ($ARGV[0] && $ARGV[0]=~/^-(n?)re/) {
+    my $ary= $1 ? \@anti_re : \@re;
+
+    if ( $ARGV[0] !~ /=/ ) {
+        shift @ARGV;
+        while (@ARGV and $ARGV[0] !~ /^-/) {
+            push @$ary, shift @ARGV;
+        }
     } else {
-        (undef,$re)=split/=/,shift;
+        push @$ary, (split/=/,shift @ARGV)[1];
     }
 }
 
@@ -165,7 +148,7 @@ if (@ARGV) {
        push @seq, $next;
 
        my @last;
-       push @last,  sort { lc $a cmp lc $b }
+       push @last,
            _tests_from_manifest($Config{extensions}, $Config{known_extensions});
        my %times;
        if ($state) {
@@ -177,16 +160,66 @@ if (@ARGV) {
 
        my %dir;
        my %total_time;
+        my %serials;
+        my %all_dirs;
 
+        # Preprocess the list of tests
        for (@last) {
            if ($^O eq 'MSWin32') {
                s,\\,/,g; # canonicalize path
            };
-           # Treat every file matching lib/*.t as a "directory"
-           m!\A(\.\./lib/[^/]+\.t\z|.*[/])! or die "'$_'";
+
+            # Keep a list of the distinct directory names, and another list of
+            # those which contain a file whose name begins with a 0
+            if ( m! \A \.\. /
+                                ( .*? )         # $1 is the directory path name
+                            /
+                                ( [^/]* \.t )   # $2 is the .t name
+                    \z !x)
+            {
+                my $path = $1;
+
+                $all_dirs{$path} = 1;
+                $serials{$path} = 1 if $2 =~ / \A 0 /x;
+            }
+        }
+
+        # We assume that the reason a test file's name begins with a 0 is to
+        # order its execution among the tests in its directory.  Hence, a
+        # directory containing such files should be tested in serial order.
+        #
+        # Add exceptions to the above rule
+        for (qw(ext/Pod-Html/t cpan/IO-Zlib/t ext/File-Find/t)) {
+            $serials{$_} = 1;
+        }
+
+        my @nonexistent_serials = grep { not exists $all_dirs{$_} } keys %serials;
+        if (@nonexistent_serials) {
+            die "These directories to be run serially don't exist."
+              . "  Check your spelling:\n" . join "\n", @nonexistent_serials;
+        }
+
+        # Remove the serial testing directories from the list of all
+        # directories.  The remaining ones are testable in parallel.  Make the
+        # parallel list a scalar with names separated by '|' so that below
+        # they will be added to a regular expression.
+        my $non_serials = join "|", grep { not exists $serials{$_} } keys %all_dirs;
+        undef %all_dirs;
+        undef %serials;
+
+       for (@last) {
+            # Treat every file in each non-serial directory as its own
+            # "directory", so that it can be executed in parallel
+            m! \A ( \.\. / (?: $non_serials )
+                         / [^/]+ \.t \z | .* [/] ) !x
+                or die "'$_'";
            push @{$dir{$1}}, $_;
+
+            # This file contributes time to the total needed for the directory
+            # as a whole
            $total_time{$1} += $times{$_} || 0;
        }
+        #print STDERR __LINE__, join "\n", sort { $total_time{$b} <=> $total_time{$a} } keys %dir, "  ";
 
        push @tests, @last;
 
@@ -194,7 +227,7 @@ if (@ARGV) {
        # sequentially.
        push @seq, { par => [ map { s!/$!/*!; { seq => $_ } } sort {
            # Directories, ordered by total time descending then name ascending
-           $total_time{$b} <=> $total_time{$a} || $a cmp $b
+           $total_time{$b} <=> $total_time{$a} || lc $a cmp lc $b
        } keys %dir ] };
 
        $rules = { seq => \@seq };
@@ -203,12 +236,32 @@ if (@ARGV) {
 if ($^O eq 'MSWin32') {
     s,\\,/,g for @tests;
 }
-@tests=grep /$re/, @tests 
-    if $re;
+if (@re or @anti_re) {
+    my @keepers;
+    foreach my $test (@tests) {
+        my $keep = 0;
+        if (@re) {
+            foreach my $re (@re) {
+                $keep = 1 if $test=~/$re/;
+            }
+        } else {
+            $keep = 1;
+        }
+        if (@anti_re) {
+            foreach my $anti_re (@anti_re) {
+                $keep = 0 if $test=~/$anti_re/;
+            }
+        }
+        if ($keep) {
+            push @keepers, $test;
+        }
+    }
+    @tests= @keepers;
+}
 
 # Allow eg ./perl t/harness t/op/lc.t
 for (@tests) {
-    if (-f "../$_") {
+    if (! -f $_ && !/^\.\./ && -f "../$_") {
         $_ = "../$_";
         s{^\.\./t/}{};
     }