File Coverage

blib/lib/Module/Install/ExtraTests.pm
Criterion Covered Total %
statement 21 77 27.2
branch 0 34 0.0
condition 0 12 0.0
subroutine 7 14 50.0
pod 1 1 100.0
total 29 138 21.0


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