~ubuntu-branches/ubuntu/wily/libb-hooks-op-check-entersubforcv-perl/wily

« back to all changes in this revision

Viewing changes to inc/Module/Install/ExtraTests.pm

  • Committer: Package Import Robot
  • Author(s): Stig Sandbeck Mathisen
  • Date: 2012-04-22 00:19:53 UTC
  • Revision ID: package-import@ubuntu.com-20120422001953-603chi8f9v2gwbtu
Tags: upstream-0.09
ImportĀ upstreamĀ versionĀ 0.09

Show diffs side-by-side

added added

removed removed

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