Break out the code that finds tests in MANIFEST into _tests_from_manifest().
Nicholas Clark [Wed, 26 Aug 2009 19:43:11 +0000 (20:43 +0100)]
t/TEST
t/harness

diff --git a/t/TEST b/t/TEST
index ccb226b..58f1da5 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -204,56 +204,28 @@ sub _quote_args {
 }
 
 sub _populate_hash {
+    return unless defined $_[0];
     return map {$_, 1} split /\s+/, $_[0];
 }
 
-unless (@ARGV) {
-    # base first, as TEST bails out if that can't run
-    # then comp, to validate that require works
-    # then run, to validate that -M works
-    # then we know we can -MTestInit for everything else, making life simpler
-    foreach my $dir (qw(base comp run cmd io op uni mro)) {
-       _find_tests($dir);
-    }
-    _find_tests("lib") unless $::core;
-    # Config.pm may be broken for make minitest. And this is only a refinement
-    # for skipping tests on non-default builds, so it is allowed to fail.
-    # What we want to to is make a list of extensions which we did not build.
-    my $configsh = '../config.sh';
+sub _tests_from_manifest {
+    my ($extensions, $known_extensions) = @_;
     my %skip;
-    if (-f $configsh) {
-       my (%extensions, %known_extensions);
-       open FH, $configsh or die "Can't open $configsh: $!";
-       while (<FH>) {
-           if (/^extensions=['"](.*)['"]$/) {
-               # Deliberate string interpolation to avoid triggering possible
-               # $1 resetting bugs.
-               %extensions = _populate_hash ("$1");
-           }
-           elsif (/^known_extensions=['"](.*)['"]$/) {
-               %known_extensions = _populate_hash ($1);
-           }
-       }
-       if (%extensions) {
-           if (%known_extensions) {
-               foreach (keys %known_extensions) {
-                   $skip{$_}++ unless $extensions{$_};
-               }
-           } else {
-               warn "No known_extensions line found in $configsh";
-           }
-       } else {
-           warn "No extensions line found in $configsh";
-       }
+    my %extensions = _populate_hash($extensions);
+    my %known_extensions = _populate_hash($known_extensions);
+
+    foreach (keys %known_extensions) {
+       $skip{$_}++ unless $extensions{$_};
     }
+
+    my @results;
     my $mani = '../MANIFEST';
     if (open(MANI, $mani)) {
        while (<MANI>) { # similar code in t/harness
            if (m!^(ext/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) {
                my $t = $1;
                my $extension = $2;
-               if (!$::core || $t =~ m!^lib/[a-z]!)
-               {
+               if (!$::core || $t =~ m!^lib/[a-z]!) {
                    if (defined $extension) {
                        $extension =~ s!/t$!!;
                        # XXX Do I want to warn that I'm skipping these?
@@ -263,7 +235,7 @@ unless (@ARGV) {
                        next if $skip{$flat_extension}; # Foo/Bar may live in Foo-Bar
                    }
                    my $path = "../$t";
-                   push @ARGV, $path;
+                   push @results, $path;
                    $::path_to_name{$path} = $t;
                }
            }
@@ -272,6 +244,45 @@ unless (@ARGV) {
     } else {
        warn "$0: cannot open $mani: $!\n";
     }
+    return @results;
+}
+
+unless (@ARGV) {
+    # base first, as TEST bails out if that can't run
+    # then comp, to validate that require works
+    # then run, to validate that -M works
+    # then we know we can -MTestInit for everything else, making life simpler
+    foreach my $dir (qw(base comp run cmd io op uni mro)) {
+       _find_tests($dir);
+    }
+    _find_tests("lib") unless $::core;
+    # Config.pm may be broken for make minitest. And this is only a refinement
+    # for skipping tests on non-default builds, so it is allowed to fail.
+    # What we want to to is make a list of extensions which we did not build.
+    my $configsh = '../config.sh';
+    my ($extensions, $known_extensions);
+    if (-f $configsh) {
+       open FH, $configsh or die "Can't open $configsh: $!";
+       while (<FH>) {
+           if (/^extensions=['"](.*)['"]$/) {
+               $extensions = $1;
+           }
+           elsif (/^known_extensions=['"](.*)['"]$/) {
+               $known_extensions = $1;
+           }
+       }
+       if (!defined $known_extensions) {
+           warn "No known_extensions line found in $configsh";
+       }
+       if (!defined $extensions) {
+           warn "No extensions line found in $configsh";
+       }
+    }
+    # The "complex" constructions of list return from a subroutine, and push of
+    # a list, might fail if perl is really hosed, but they aren't needed for
+    # make minitest, and the building of extensions will likely also fail if
+    # something is that badly wrong.
+    push @ARGV, _tests_from_manifest($extensions, $known_extensions);
     unless ($::core) {
        _find_tests('pod');
        _find_tests('x2p');
index afd4b6f..ee47fff 100644 (file)
--- a/t/harness
+++ b/t/harness
@@ -103,6 +103,42 @@ if ($ENV{HARNESS_OPTIONS}) {
     }
 }
 
+sub _tests_from_manifest {
+    my ($extensions, $known_extensions) = @_;
+    my %skip;
+    my %extensions = _populate_hash($extensions);
+    my %known_extensions = _populate_hash($known_extensions);
+
+    foreach (keys %known_extensions) {
+       $skip{$_}++ unless $extensions{$_};
+    }
+
+    my @results;
+    use File::Spec;
+    my $updir = File::Spec->updir;
+    my $mani  = File::Spec->catfile(File::Spec->updir, "MANIFEST");
+    if (open(MANI, $mani)) {
+       while (<MANI>) { # similar code in t/TEST
+           if (m!^(ext/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) {
+               my ($test, $extension) = ($1, $2);
+               if (defined $extension) {
+                   $extension =~ s!/t$!!;
+                   # XXX Do I want to warn that I'm skipping these?
+                   next if $skip{$extension};
+                   my $flat_extension = $extension;
+                   $flat_extension =~ s!-!/!g;
+                   next if $skip{$flat_extension}; # Foo/Bar may live in Foo-Bar
+               }
+               push @results, File::Spec->catfile($updir, $test);
+           }
+       }
+       close MANI;
+    } else {
+       warn "$0: cannot open $mani: $!\n";
+    }
+    return @results;
+}
+
 if (@ARGV) {
     # If you want these run in speed order, just use prove
     if ($^O eq 'MSWin32') {
@@ -160,40 +196,8 @@ if (@ARGV) {
 
        my @last;
        use Config;
-       my %skip;
-       {
-           my %extensions = _populate_hash $Config{'extensions'};
-           my %known_extensions = _populate_hash $Config{'known_extensions'};
-           foreach (keys %known_extensions) {
-               $skip{$_}++ unless $extensions{$_};
-           }
-       }
-       use File::Spec;
-       my $updir = File::Spec->updir;
-       my $mani  = File::Spec->catfile(File::Spec->updir, "MANIFEST");
-       if (open(MANI, $mani)) {
-           my @manitests = ();
-           while (<MANI>) { # similar code in t/TEST
-               if (m!^(ext/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) {
-                   my ($test, $extension) = ($1, $2);
-                   if (defined $extension) {
-                       $extension =~ s!/t$!!;
-                       # XXX Do I want to warn that I'm skipping these?
-                       next if $skip{$extension};
-                       my $flat_extension = $extension;
-                       $flat_extension =~ s!-!/!g;
-                       next if $skip{$flat_extension}; # Foo/Bar may live in Foo-Bar
-                   }
-                   push @manitests, File::Spec->catfile($updir, $test);
-               }
-           }
-           close MANI;
-           # Sort the list of test files read from MANIFEST into a sensible
-           # order instead of using the order in which they are listed there
-           push @last, sort { lc $a cmp lc $b } @manitests;
-       } else {
-           warn "$0: cannot open $mani: $!\n";
-       }
+       push @last,  sort { lc $a cmp lc $b }
+           _tests_from_manifest($Config{extensions}, $Config{known_extensions});
        push @last, <pod/*.t>;
        push @last, <x2p/*.t>;