From: Nicholas Clark Date: Wed, 26 Aug 2009 19:43:11 +0000 (+0100) Subject: Break out the code that finds tests in MANIFEST into _tests_from_manifest(). X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3323f52209391b4b2c45b3e1feb26c6f51fb6fa;p=p5sagit%2Fp5-mst-13.2.git Break out the code that finds tests in MANIFEST into _tests_from_manifest(). --- diff --git a/t/TEST b/t/TEST index ccb226b..58f1da5 100755 --- 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 () { - 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 () { # 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 () { + 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'); diff --git a/t/harness b/t/harness index afd4b6f..ee47fff 100644 --- 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 () { # 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 () { # 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, ; push @last, ;