This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid extra newlines on VMS in t/opbasic/arith.t
[perl5.git] / t / harness
index 30f4b1a..5ae2702 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) {
@@ -183,7 +166,9 @@ if (@ARGV) {
                s,\\,/,g; # canonicalize path
            };
            # Treat every file matching lib/*.t as a "directory"
-           m!\A(\.\./lib/[^/]+\.t\z|.*[/])! or die "'$_'";
+           m! \A ( \.\. / (?: lib | ext/XS-APItest/t )
+                         / [^/]+ \.t \z | .* [/] ) !x
+                or die "'$_'";
            push @{$dir{$1}}, $_;
            $total_time{$1} += $times{$_} || 0;
        }
@@ -194,7 +179,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 +188,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/}{};
     }