1#line 1 2use strict; 3use warnings; 4use 5.006; 5package Module::Install::ExtraTests; 6use Module::Install::Base; 7 8BEGIN { 9 our $VERSION = '0.004'; 10 our $ISCORE = 1; 11 our @ISA = qw{Module::Install::Base}; 12} 13 14sub extra_tests { 15 my ($self) = @_; 16 17 return unless -d 'xt'; 18 return unless my @content = grep { $_ =~ /^[.]/ } <xt/*>; 19 20 die "unknown files found in ./xt" if grep { -f } @content; 21 22 my %known = map {; $_ => 1 } qw(author smoke release); 23 my @unknown = grep { not $known{$_} } @content; 24 die "unknown directories found in ./xt: @unknown" if @unknown; 25 26 { 27 no warnings qw(closure once); 28 package # The newline tells PAUSE, "DO NOT INDEXING!" 29 MY; 30 sub test_via_harness { 31 my ($self, $perl, $tests) = @_; 32 my $a_str = -d 'xt/author' ? 'xt/author' : ''; 33 my $r_str = -d 'xt/release' ? 'xt/release' : ''; 34 my $s_str = -d 'xt/smoke' ? 'xt/smoke' : ''; 35 my $is_author = $Module::Install::AUTHOR ? 1 : 0; 36 37 return qq{\t$perl "-Iinc" "-MModule::Install::ExtraTests" } 38 . qq{"-e" "Module::Install::ExtraTests::__harness('Test::Harness', $is_author, '$a_str', '$r_str', '$s_str', \$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n}; 39 } 40 41 sub dist_test { 42 my ($self, @args) = @_; 43 my $text = $self->SUPER::dist_test(@args); 44 my @lines = split /\n/, $text; 45 $_ =~ s/ (\S*MAKE\S* test )/ RELEASE_TESTING=1 $1 / for grep { m/ test / } @lines; 46 return join "\n", @lines; 47 } 48 49 } 50} 51 52sub __harness { 53 my $harness_class = shift; 54 my $is_author = shift; 55 my $author_tests = shift; 56 my $release_tests = shift; 57 my $smoke_tests = shift; 58 59 eval "require $harness_class; 1" or die; 60 require File::Spec; 61 62 my $verbose = shift; 63 eval "\$$harness_class\::verbose = $verbose; 1" or die; 64 65 # Because Windows doesn't do this for us and listing all the *.t files 66 # out on the command line can blow over its exec limit. 67 require ExtUtils::Command; 68 push @ARGV, __PACKAGE__->_deep_t($author_tests) 69 if $author_tests and $is_author; 70 71 push @ARGV, __PACKAGE__->_deep_t($release_tests) 72 if $release_tests and $ENV{RELEASE_TESTING}; 73 74 push @ARGV, __PACKAGE__->_deep_t($smoke_tests) 75 if $smoke_tests and $ENV{AUTOMATED_TESTING}; 76 77 my @argv = ExtUtils::Command::expand_wildcards(@ARGV); 78 79 local @INC = @INC; 80 unshift @INC, map { File::Spec->rel2abs($_) } @_; 81 $harness_class->can('runtests')->(sort { lc $a cmp lc $b } @argv); 82} 83 84sub _wanted { 85 my $href = shift; 86 no warnings 'once'; 87 sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 } 88} 89 90sub _deep_t { 91 my ($self, $dir) = @_; 92 require File::Find; 93 94 my %test_dir; 95 File::Find::find(_wanted(\%test_dir), $dir); 96 return map { "$_/*.t" } sort keys %test_dir; 97} 98 991; 100__END__ 101