line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mason::Test::Class; |
2
|
|
|
|
|
|
|
$Mason::Test::Class::VERSION = '2.22'; |
3
|
20
|
|
|
20
|
|
2349232
|
use Carp; |
|
20
|
|
|
|
|
52
|
|
|
20
|
|
|
|
|
3142
|
|
4
|
20
|
|
|
20
|
|
118
|
use File::Basename; |
|
20
|
|
|
|
|
38
|
|
|
20
|
|
|
|
|
3174
|
|
5
|
20
|
|
|
20
|
|
110
|
use File::Path; |
|
20
|
|
|
|
|
35
|
|
|
20
|
|
|
|
|
1597
|
|
6
|
20
|
|
|
20
|
|
32502
|
use File::Temp qw(tempdir); |
|
20
|
|
|
|
|
598317
|
|
|
20
|
|
|
|
|
1571
|
|
7
|
20
|
|
|
20
|
|
10766
|
use Mason; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
use Mason::Util qw(trim write_file); |
9
|
|
|
|
|
|
|
use Method::Signatures::Simple; |
10
|
|
|
|
|
|
|
use Test::Class::Most; |
11
|
|
|
|
|
|
|
use Test::LongString; |
12
|
|
|
|
|
|
|
use Class::Load; |
13
|
|
|
|
|
|
|
use strict; |
14
|
|
|
|
|
|
|
use warnings; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
__PACKAGE__->SKIP_CLASS("abstract base class"); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# RO accessors |
19
|
|
|
|
|
|
|
sub comp_root { $_[0]->{comp_root} } |
20
|
|
|
|
|
|
|
sub data_dir { $_[0]->{data_dir} } |
21
|
|
|
|
|
|
|
sub interp { $_[0]->{interp} } |
22
|
|
|
|
|
|
|
sub temp_dir { $_[0]->{temp_dir} } |
23
|
|
|
|
|
|
|
sub temp_root { $_[0]->{temp_root} } |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# RW class accessors |
26
|
|
|
|
|
|
|
my $default_plugins = []; |
27
|
|
|
|
|
|
|
sub default_plugins { $default_plugins = $_[1] if defined( $_[1] ); $default_plugins; } |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $gen_path_count = 0; |
30
|
|
|
|
|
|
|
my $parse_count = 0; |
31
|
|
|
|
|
|
|
my $temp_dir_count = 0; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
our $current_test_object; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub _startup : Test(startup) { |
36
|
|
|
|
|
|
|
my $self = shift; |
37
|
|
|
|
|
|
|
my $verbose = $ENV{TEST_VERBOSE}; |
38
|
|
|
|
|
|
|
$self->{temp_root} = tempdir( 'mason-test-XXXX', TMPDIR => 1, CLEANUP => $verbose ? 0 : 1 ); |
39
|
|
|
|
|
|
|
printf STDERR ( "\n*** temp_root = %s, no cleanup\n", $self->{temp_root} ) if $verbose; |
40
|
|
|
|
|
|
|
$self->setup_dirs; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
method setup_dirs () { |
44
|
|
|
|
|
|
|
$self->{temp_dir} = join( "/", $self->{temp_root}, $temp_dir_count++ ); |
45
|
|
|
|
|
|
|
$self->{comp_root} = $self->{temp_dir} . "/comps"; |
46
|
|
|
|
|
|
|
$self->{data_dir} = $self->{temp_dir} . "/data"; |
47
|
|
|
|
|
|
|
mkpath( [ $self->{comp_root}, $self->{data_dir} ], 0, 0775 ); |
48
|
|
|
|
|
|
|
$self->setup_interp(@_); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
method setup_interp () { |
52
|
|
|
|
|
|
|
$self->{interp} = $self->create_interp(@_); |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
method create_interp () { |
56
|
|
|
|
|
|
|
my (%params) = @_; |
57
|
|
|
|
|
|
|
$params{plugins} = $default_plugins if @$default_plugins; |
58
|
|
|
|
|
|
|
my $mason_root_class = delete( $params{mason_root_class} ) || 'Mason'; |
59
|
|
|
|
|
|
|
Class::Load::load_class($mason_root_class); |
60
|
|
|
|
|
|
|
rmtree( $self->data_dir ); |
61
|
|
|
|
|
|
|
return $mason_root_class->new( |
62
|
|
|
|
|
|
|
comp_root => $self->comp_root, |
63
|
|
|
|
|
|
|
data_dir => $self->data_dir, |
64
|
|
|
|
|
|
|
%params, |
65
|
|
|
|
|
|
|
); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
method add_comp (%params) { |
69
|
|
|
|
|
|
|
$self->_validate_keys( \%params, qw(path src v verbose) ); |
70
|
|
|
|
|
|
|
my $path = $params{path} || die "must pass path"; |
71
|
|
|
|
|
|
|
my $source = $params{src} || " "; |
72
|
|
|
|
|
|
|
my $verbose = $params{v} || $params{verbose}; |
73
|
|
|
|
|
|
|
die "'$path' is not absolute" unless substr( $path, 0, 1 ) eq '/'; |
74
|
|
|
|
|
|
|
my $source_file = $self->comp_root . $path; |
75
|
|
|
|
|
|
|
$self->mkpath_and_write_file( $source_file, $source ); |
76
|
|
|
|
|
|
|
if ($verbose) { |
77
|
|
|
|
|
|
|
print STDERR "*** $path ***\n"; |
78
|
|
|
|
|
|
|
my $output = $self->interp->_compile( $source_file, $path ); |
79
|
|
|
|
|
|
|
print STDERR "$output\n"; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
method remove_comp (%params) { |
84
|
|
|
|
|
|
|
my $path = $params{path} || die "must pass path"; |
85
|
|
|
|
|
|
|
my $source_file = join( "/", $self->comp_root, $path ); |
86
|
|
|
|
|
|
|
unlink($source_file); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
method _gen_comp_path () { |
90
|
|
|
|
|
|
|
my $caller = ( caller(2) )[3]; |
91
|
|
|
|
|
|
|
my ($caller_base) = ( $caller =~ /([^:]+)$/ ); |
92
|
|
|
|
|
|
|
my $path = "/$caller_base" . ( ++$gen_path_count ) . ".mc"; |
93
|
|
|
|
|
|
|
return $path; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
method test_comp (%params) { |
97
|
|
|
|
|
|
|
my $path = $params{path} || $self->_gen_comp_path; |
98
|
|
|
|
|
|
|
my $source = $params{src} || " "; |
99
|
|
|
|
|
|
|
my $verbose = $params{v} || $params{verbose}; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
$self->add_comp( path => $path, src => $source, verbose => $verbose ); |
102
|
|
|
|
|
|
|
delete( $params{src} ); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
$self->test_existing_comp( %params, path => $path ); |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
method test_existing_comp (%params) { |
108
|
|
|
|
|
|
|
$self->_validate_keys( \%params, qw(args desc expect expect_data expect_error path v verbose) ); |
109
|
|
|
|
|
|
|
my $path = $params{path} or die "must pass path"; |
110
|
|
|
|
|
|
|
my $caller = ( caller(1) )[3]; |
111
|
|
|
|
|
|
|
my $desc = $params{desc} || $path; |
112
|
|
|
|
|
|
|
my $expect = trim( $params{expect} ); |
113
|
|
|
|
|
|
|
my $expect_error = $params{expect_error}; |
114
|
|
|
|
|
|
|
my $expect_data = $params{expect_data}; |
115
|
|
|
|
|
|
|
my $verbose = $params{v} || $params{verbose}; |
116
|
|
|
|
|
|
|
my $args = $params{args} || {}; |
117
|
|
|
|
|
|
|
( my $request_path = $path ) =~ s/\.m[cpi]$//; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
my @run_params = ( $request_path, %$args ); |
120
|
|
|
|
|
|
|
local $current_test_object = $self; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
if ( defined($expect_error) ) { |
123
|
|
|
|
|
|
|
$desc ||= $expect_error; |
124
|
|
|
|
|
|
|
throws_ok( sub { $self->interp->run(@run_params) }, $expect_error, $desc ); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
if ( defined($expect) ) { |
127
|
|
|
|
|
|
|
$desc ||= $caller; |
128
|
|
|
|
|
|
|
my $output = trim( $self->interp->run(@run_params)->output ); |
129
|
|
|
|
|
|
|
if ( ref($expect) eq 'Regexp' ) { |
130
|
|
|
|
|
|
|
like( $output, $expect, $desc ); |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
else { |
133
|
|
|
|
|
|
|
is( $output, $expect, $desc ); |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
if ( defined($expect_data) ) { |
137
|
|
|
|
|
|
|
$desc ||= $caller; |
138
|
|
|
|
|
|
|
cmp_deeply( $self->interp->run(@run_params)->data, $expect_data, $desc ); |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
method run_test_in_comp (%params) { |
143
|
|
|
|
|
|
|
my $test = delete( $params{test} ) || die "must pass test"; |
144
|
|
|
|
|
|
|
my $args = delete( $params{args} ) || {}; |
145
|
|
|
|
|
|
|
$params{path} ||= $self->_gen_comp_path; |
146
|
|
|
|
|
|
|
$self->add_comp( %params, src => '% $.args->{_test}->($self);' ); |
147
|
|
|
|
|
|
|
( my $request_path = $params{path} ) =~ s/\.m[cpi]$//; |
148
|
|
|
|
|
|
|
my @run_params = ( $request_path, %$args ); |
149
|
|
|
|
|
|
|
$self->interp->run( @run_params, _test => $test ); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
method test_parse (%params) { |
153
|
|
|
|
|
|
|
my $caller = ( caller(1) )[3]; |
154
|
|
|
|
|
|
|
my ($caller_base) = ( $caller =~ /([^:]+)$/ ); |
155
|
|
|
|
|
|
|
my $desc = $params{desc}; |
156
|
|
|
|
|
|
|
my $source = $params{src} || croak "must pass src"; |
157
|
|
|
|
|
|
|
my $expect_list = $params{expect}; |
158
|
|
|
|
|
|
|
my $expect_error = $params{expect_error}; |
159
|
|
|
|
|
|
|
croak "must pass either expect or expect_error" unless $expect_list || $expect_error; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
my $path = "/parse/comp" . $parse_count++; |
162
|
|
|
|
|
|
|
my $file = $self->temp_dir . $path; |
163
|
|
|
|
|
|
|
$self->mkpath_and_write_file( $file, $source ); |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
if ($expect_error) { |
166
|
|
|
|
|
|
|
$desc ||= $expect_error; |
167
|
|
|
|
|
|
|
throws_ok( sub { $self->interp->_compile( $file, $path ) }, $expect_error, $desc ); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
else { |
170
|
|
|
|
|
|
|
$desc ||= $caller; |
171
|
|
|
|
|
|
|
my $output = $self->interp->_compile( $file, $path ); |
172
|
|
|
|
|
|
|
foreach my $expect (@$expect_list) { |
173
|
|
|
|
|
|
|
if ( ref($expect) eq 'Regexp' ) { |
174
|
|
|
|
|
|
|
like_string( $output, $expect, "$desc - $expect" ); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
else { |
177
|
|
|
|
|
|
|
contains_string( $output, $expect, "$desc - $expect" ); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
method mkpath_and_write_file ($source_file, $source) { |
184
|
|
|
|
|
|
|
unlink($source_file) if -e $source_file; |
185
|
|
|
|
|
|
|
mkpath( dirname($source_file), 0, 0775 ); |
186
|
|
|
|
|
|
|
write_file( $source_file, $source ); |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
method _validate_keys ($params, @allowed_keys) { |
190
|
|
|
|
|
|
|
my %is_allowed = map { ( $_, 1 ) } @allowed_keys; |
191
|
|
|
|
|
|
|
if ( my @bad_keys = grep { !$is_allowed{$_} } keys(%$params) ) { |
192
|
|
|
|
|
|
|
croak "bad parameters: " . join( ", ", @bad_keys ); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
1; |