1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
#line 1
package Module::Install::TestTarget;
use 5.006_002;
use strict;
#use warnings; # XXX: warnings.pm produces a lot of 'redefine' warnings!
our $VERSION = '0.19';
use base qw(Module::Install::Base);
use Config;
use Carp qw(croak);
our($ORIG_TEST_VIA_HARNESS);
our $TEST_DYNAMIC = {
env => '',
includes => '',
load_modules => '',
insert_on_prepare => '',
insert_on_finalize => '',
run_on_prepare => '',
run_on_finalize => '',
};
# override the default `make test`
sub default_test_target {
my ($self, %args) = @_;
my %test = _build_command_parts(%args);
$TEST_DYNAMIC = \%test;
}
# create a new test target
sub test_target {
my ($self, $target, %args) = @_;
croak 'target must be spesiced at test_target()' unless $target;
my $alias = "\n";
if($args{alias}) {
$alias .= qq{$args{alias} :: $target\n\n};
}
if($Module::Install::AUTHOR && $args{alias_for_author}) {
$alias .= qq{$args{alias_for_author} :: $target\n\n};
}
my $test = _assemble(_build_command_parts(%args));
$self->postamble(
$alias
. qq{$target :: pure_all\n}
. qq{\t} . $test
);
}
sub _build_command_parts {
my %args = @_;
#XXX: _build_command_parts() will be called first, so we put it here
unless(defined $ORIG_TEST_VIA_HARNESS) {
$ORIG_TEST_VIA_HARNESS = MY->can('test_via_harness');
no warnings 'redefine';
*MY::test_via_harness = \&_test_via_harness;
}
for my $key (qw/includes load_modules run_on_prepare run_on_finalize insert_on_prepare insert_on_finalize tests/) {
$args{$key} ||= [];
$args{$key} = [$args{$key}] unless ref $args{$key} eq 'ARRAY';
}
$args{env} ||= {};
my %test;
$test{includes} = @{$args{includes}} ? join '', map { qq|"-I$_" | } @{$args{includes}} : '';
$test{load_modules} = @{$args{load_modules}} ? join '', map { qq|"-M$_" | } @{$args{load_modules}} : '';
$test{tests} = @{$args{tests}}
? join '', map { qq|"$_" | } @{$args{tests}}
: '$(TEST_FILES)';
for my $key (qw/run_on_prepare run_on_finalize/) {
$test{$key} = @{$args{$key}} ? join '', map { qq|do { local \$@; do '$_'; die \$@ if \$@ }; | } @{$args{$key}} : '';
$test{$key} = _quote($test{$key});
}
for my $key (qw/insert_on_prepare insert_on_finalize/) {
my $codes = join '', map { _build_funcall($_) } @{$args{$key}};
$test{$key} = _quote($codes);
}
$test{env} = %{$args{env}} ? _quote(join '', map {
my $key = _env_quote($_);
my $val = _env_quote($args{env}->{$_});
sprintf "\$ENV{q{%s}} = q{%s}; ", $key, $val
} keys %{$args{env}}) : '';
return %test;
}
my $bd;
sub _build_funcall {
my($code) = @_;
if(ref $code eq 'CODE') {
$bd ||= do { require B::Deparse; B::Deparse->new() };
$code = $bd->coderef2text($code);
}
return qq|sub { $code }->(); |;
}
sub _quote {
my $code = shift;
$code =~ s/\$/\\\$\$/g;
$code =~ s/"/\\"/g;
$code =~ s/\n/ /g;
if ($^O eq 'MSWin32') {
$code =~ s/\\\$\$/\$\$/g;
if ($Config{make} =~ /dmake/i) {
$code =~ s/{/{{/g;
$code =~ s/}/}}/g;
}
}
return $code;
}
sub _env_quote {
my $val = shift;
$val =~ s/}/\\}/g;
return $val;
}
sub _assemble {
my %args = @_;
my $command = MY->$ORIG_TEST_VIA_HARNESS($args{perl} || '$(FULLPERLRUN)', $args{tests});
# inject includes and modules before the first switch
$command =~ s/("- \S+? ")/$args{includes}$args{load_modules}$1/xms;
# inject snipetts in the one-liner
$command =~ s{
( "-e" \s+ ") # start the one liner
( (?: [^"] | \\ . )+ ) # body of the one liner
( " ) # end the one liner
}{
join '', $1,
$args{env},
$args{run_on_prepare},
$args{insert_on_prepare},
"$2; ",
$args{run_on_finalize},
$args{insert_on_finalize},
$3,
}xmse;
return $command;
}
sub _test_via_harness {
my($self, $perl, $tests) = @_;
$TEST_DYNAMIC->{perl} = $perl;
$TEST_DYNAMIC->{tests} ||= $tests;
return _assemble(%$TEST_DYNAMIC);
}
1;
__END__
#line 393
|
