line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Functional; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
87647
|
use warnings FATAL => 'all'; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
152
|
|
4
|
3
|
|
|
3
|
|
18
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
200
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.06'; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
Test::Functional - Perl tests in a functional style. |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 SYNOPSIS |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use Test::Functional; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# make sure the bomb goes off |
17
|
|
|
|
|
|
|
sub explode { die "BOOM" } |
18
|
|
|
|
|
|
|
test { explode() } dies, "test-3"; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# implicit and explicit equivalence |
21
|
|
|
|
|
|
|
test { 2 * 2 } 4, "test-1"; |
22
|
|
|
|
|
|
|
test { 2 * 2 } eqv 4, "test-1"; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# test blocks can be as simple or as involved as you want |
25
|
|
|
|
|
|
|
test { 3 > 0 } true, "test-4"; |
26
|
|
|
|
|
|
|
test { |
27
|
|
|
|
|
|
|
my $total = 0; |
28
|
|
|
|
|
|
|
foreach my $person ($car->occupants) { |
29
|
|
|
|
|
|
|
$total += $person->weight |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
$total < 600 |
32
|
|
|
|
|
|
|
} true, "test-5"; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# after the test runs, you also get the result. |
35
|
|
|
|
|
|
|
my $horse = test { Horse->new } typeqv "Horse", "test-6"; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# you can make your own comparator functions, or use existing ones. |
38
|
|
|
|
|
|
|
use Test::More import => [qw(like)]; |
39
|
|
|
|
|
|
|
sub islike { |
40
|
|
|
|
|
|
|
my ($other) = @_; |
41
|
|
|
|
|
|
|
return sub { |
42
|
|
|
|
|
|
|
my ($got, $testname) = @_; |
43
|
|
|
|
|
|
|
like($got, $other, $testname); |
44
|
|
|
|
|
|
|
}; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
test { 'caterpillar' } islike(qr/cat/), 'is cat?'; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 DESCRIPTION |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
This modules uses (abuses?) the ability to create new syntax via perl |
51
|
|
|
|
|
|
|
prototypes to create a testing system focused on functions rather than values. |
52
|
|
|
|
|
|
|
Tests run blocks of Perl, and use comparator functions to test the output. |
53
|
|
|
|
|
|
|
Despite being a different way of thinking about tests, it plays well with |
54
|
|
|
|
|
|
|
L and friends. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=cut |
57
|
3
|
|
|
3
|
|
2745
|
use Data::Compare qw(Compare); |
|
3
|
|
|
|
|
59271
|
|
|
3
|
|
|
|
|
29
|
|
58
|
3
|
|
|
3
|
|
12811
|
use Scalar::Quote qw(quote); |
|
3
|
|
|
|
|
5494
|
|
|
3
|
|
|
|
|
264
|
|
59
|
3
|
|
|
3
|
|
148
|
use Scalar::Util qw(blessed looks_like_number reftype); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
218
|
|
60
|
3
|
|
|
3
|
|
1222
|
use Test::More import => ['is_deeply']; |
|
3
|
|
|
|
|
33210
|
|
|
3
|
|
|
|
|
42
|
|
61
|
3
|
|
|
3
|
|
3229
|
use Test::Functional::Conf; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
20
|
|
62
|
|
|
|
|
|
|
|
63
|
3
|
|
|
3
|
|
20
|
use base 'Test::Builder::Module'; |
|
3
|
|
|
|
|
12
|
|
|
3
|
|
|
|
|
6024
|
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head1 EXPORTS |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Since this module is going to be used for test scripts, its methods all export |
68
|
|
|
|
|
|
|
by default. You can choose which you want using the standard directives: |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# import only eqv |
71
|
|
|
|
|
|
|
use Test::Functional tests => 23, import => ['eqv']; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# import all but notest |
74
|
|
|
|
|
|
|
use Test::Functional tests => 23, import => ['!notest']; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=cut |
77
|
|
|
|
|
|
|
our @EXPORT = ( |
78
|
|
|
|
|
|
|
qw(test pretest notest group), |
79
|
|
|
|
|
|
|
qw(eqv ineqv typeqv dies noop true false isdef isundef), |
80
|
|
|
|
|
|
|
); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# three global variables: two settings and a stack for test groups |
83
|
|
|
|
|
|
|
my ($UNSTABLE, $FASTOUT, @STACK); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head1 CONFIGURE |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
This package has two settings which can be altered to change performance: |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
unstable - run tests which are normally skipped |
90
|
|
|
|
|
|
|
fastout - cause the entire test to end after the first failure |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
This package can be configured via L or the configure() |
93
|
|
|
|
|
|
|
function. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=over |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=item configure KEY => VALUE, ... |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
Changes configuration values at run-time. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=cut |
102
|
|
|
|
|
|
|
sub configure { |
103
|
3
|
|
|
3
|
1
|
11
|
my (%opts) = @_; |
104
|
3
|
50
|
|
|
|
22
|
$UNSTABLE = $opts{unstable} if exists($opts{unstable}); |
105
|
3
|
50
|
|
|
|
22
|
$FASTOUT = $opts{fastout} if exists($opts{fastout}); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
configure( |
109
|
|
|
|
|
|
|
unstable => Test::Functional::Conf->unstable, |
110
|
|
|
|
|
|
|
fastout => Test::Functional::Conf->fastout, |
111
|
|
|
|
|
|
|
); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=back |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head1 TEST STRUCTURES |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=over |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=item B |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
This is the basic building block of Test::Functional. Each test function |
122
|
|
|
|
|
|
|
contains an anonymous code block (which is expected to return a scalar |
123
|
|
|
|
|
|
|
I), a name for the test, and a condition (an optional subroutine to |
124
|
|
|
|
|
|
|
check the result). |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
In most cases, a test passes if the code block doesn't die, and if the condition |
127
|
|
|
|
|
|
|
is true (or absent). There is a special condition I which expects the code |
128
|
|
|
|
|
|
|
block to die, and fails unless it does so. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Whether the test passes or fails, I returns the value generated by |
131
|
|
|
|
|
|
|
I. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut |
134
|
|
|
|
|
|
|
sub test(&$;$) { |
135
|
378
|
|
|
378
|
1
|
791
|
return _test(0, @_); |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=item B |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
This works like I except that if it fails, it will short-circuit all |
141
|
|
|
|
|
|
|
testing at the current level. This means that top-level I calls will |
142
|
|
|
|
|
|
|
halt the entire test if they fail. One obvious example for this is: |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
BEGIN { pretest { use Foo::Bar } "test-use" } |
145
|
|
|
|
|
|
|
test { Foo::Bar::double(2) } eqv(4), "double(2)"; |
146
|
|
|
|
|
|
|
test { Foo::Bar::double(3) } eqv(6), "double(3)"; |
147
|
|
|
|
|
|
|
test { Foo::Bar::double(4) } eqv(8), "double(4)"; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
If the C |
150
|
|
|
|
|
|
|
failing is less useful. I can also be combined with I |
151
|
|
|
|
|
|
|
(described later) to short-circuit a small set of related tests. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=cut |
154
|
|
|
|
|
|
|
sub pretest(&$;$) { |
155
|
0
|
|
|
0
|
1
|
0
|
return _test(1, @_); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=item B |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
This is has exactly the same semantics as I; the only difference is that |
161
|
|
|
|
|
|
|
it normally doesn't run. If C<< Test::Functional::Conf->unstable >> is true, |
162
|
|
|
|
|
|
|
then this test will run, otherwise it won't, and will just return undef. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
For test-driven development, it is useful to create failing tests using |
165
|
|
|
|
|
|
|
I blocks; this prevents test regression. Once the implementation starts |
166
|
|
|
|
|
|
|
working I can be switched to I. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=cut |
169
|
|
|
|
|
|
|
sub notest(&$;$) { |
170
|
0
|
0
|
|
0
|
1
|
0
|
if($UNSTABLE) { |
171
|
0
|
|
|
|
|
0
|
return _test(0, @_); |
172
|
|
|
|
|
|
|
} else { |
173
|
0
|
|
|
|
|
0
|
my $t = __PACKAGE__->builder(); |
174
|
0
|
|
|
|
|
0
|
$t->skip("$_[-1]"); |
175
|
0
|
|
|
|
|
0
|
return undef; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# $dies is a special code ref that we can test for equality. this code doesn't |
180
|
|
|
|
|
|
|
# actually get run; it's more like a constant. |
181
|
|
|
|
|
|
|
my $dies = sub {}; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# helper function for test, notest and pretest |
184
|
|
|
|
|
|
|
sub _test { |
185
|
378
|
|
|
378
|
|
582
|
my ($pre, $testfunc, $cmpfunc, $name) = @_; |
186
|
378
|
100
|
|
|
|
1345
|
if(scalar(@_) == 3) { |
|
|
100
|
|
|
|
|
|
187
|
1
|
|
|
|
|
2
|
$name = $_[-1]; |
188
|
1
|
|
|
|
|
4
|
$cmpfunc = noop(); |
189
|
|
|
|
|
|
|
} elsif(ref($cmpfunc) ne 'CODE') { |
190
|
17
|
|
|
|
|
37
|
$cmpfunc = eqv($cmpfunc); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
378
|
|
|
|
|
476
|
my $result = eval { &$testfunc() }; |
|
378
|
|
|
|
|
1414
|
|
194
|
378
|
50
|
|
|
|
3039
|
$name = @STACK ? join(".", @STACK) . ".$name" : $name; |
195
|
|
|
|
|
|
|
|
196
|
378
|
|
|
|
|
1352
|
my $t = __PACKAGE__->builder(); |
197
|
378
|
|
|
|
|
3977
|
$t->level(3); |
198
|
378
|
100
|
|
|
|
2975
|
return _ok($@, $name, " failed to die") if $cmpfunc eq $dies; |
199
|
373
|
|
|
|
|
567
|
my $ok; |
200
|
373
|
50
|
|
|
|
994
|
if($@) { |
201
|
0
|
0
|
|
|
|
0
|
_fail($name, " died: $@") if $@; |
202
|
0
|
|
|
|
|
0
|
$ok = 0; |
203
|
|
|
|
|
|
|
} else { |
204
|
373
|
|
|
|
|
1005
|
$t->level(4); |
205
|
373
|
|
|
|
|
2005
|
$ok = &$cmpfunc($result, $name); |
206
|
|
|
|
|
|
|
} |
207
|
373
|
0
|
33
|
|
|
26655
|
die if $pre && !$ok && @STACK; |
|
|
|
33
|
|
|
|
|
208
|
373
|
50
|
33
|
|
|
851
|
$t->BAIL_OUT("pretest failed") if !$ok && $pre; |
209
|
373
|
50
|
33
|
|
|
827
|
$t->BAIL_OUT("fastout is on") if !$ok && $FASTOUT; |
210
|
373
|
|
|
|
|
3311
|
return $result; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# helper function; wraps calls to builder->ok, displays failure messages, and |
214
|
|
|
|
|
|
|
# helps keep our builder->level consistent. |
215
|
|
|
|
|
|
|
sub _ok { |
216
|
342
|
|
|
342
|
|
15206
|
my ($ok, $name, $failmsg) = @_; |
217
|
342
|
|
|
|
|
1428
|
my $t = __PACKAGE__->builder; |
218
|
342
|
|
|
|
|
3207
|
$t->ok($ok, $name); |
219
|
342
|
50
|
33
|
|
|
162940
|
$t->diag($failmsg) if !$ok && $failmsg; |
220
|
342
|
|
|
|
|
1286
|
return $ok; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# similar to _ok, but deals with known failure. |
224
|
|
|
|
|
|
|
sub _fail { |
225
|
0
|
|
|
0
|
|
0
|
my ($name, $failmsg) = @_; |
226
|
0
|
|
|
|
|
0
|
my $t = __PACKAGE__->builder; |
227
|
0
|
|
|
|
|
0
|
$t->ok(0, $name); |
228
|
0
|
0
|
|
|
|
0
|
$t->diag($failmsg) if $failmsg; |
229
|
0
|
|
|
|
|
0
|
return 0; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=item B |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Groups are blocks which wrap associated tests. Groups can be used to namespace |
235
|
|
|
|
|
|
|
tests as well as to allow groups of tests to fail together. Here is a short |
236
|
|
|
|
|
|
|
example: |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
group { |
239
|
|
|
|
|
|
|
my $a = coretest { Adder->new } typeqv 'Adder', "new"; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
test { $a->add(4, 6) } 10, "4 + 6"; |
242
|
|
|
|
|
|
|
test { $a->add("cat", "dog") } dies, "mass hysteria"; |
243
|
|
|
|
|
|
|
test { $a->add() } isundef, "not a number"; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
} "adder"; |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
If C<< Adder->new >> fails, the rest of the tests aren't producing useful |
248
|
|
|
|
|
|
|
results, so they will be skipped. See the L section for a more in-depth |
249
|
|
|
|
|
|
|
discussion of the package in general, and the implications of test |
250
|
|
|
|
|
|
|
short-circuiting in particular. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=cut |
253
|
|
|
|
|
|
|
sub group(&$) { |
254
|
0
|
|
|
0
|
1
|
0
|
my ($func, $name) = @_; |
255
|
|
|
|
|
|
|
|
256
|
0
|
|
|
|
|
0
|
push(@STACK, $name); |
257
|
0
|
|
|
|
|
0
|
eval { &$func() }; |
|
0
|
|
|
|
|
0
|
|
258
|
0
|
|
|
|
|
0
|
pop(@STACK); |
259
|
|
|
|
|
|
|
|
260
|
0
|
0
|
0
|
|
|
0
|
die if $@ && @STACK; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=back |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=head1 TEST CONDITIONS |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=over |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=item B |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Creates a function which tests that the result is exactly equivalent (eqv) to |
272
|
|
|
|
|
|
|
I |
273
|
|
|
|
|
|
|
nested data structures. See L for more details. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
If I receives a condition which isn't a code-ref, it will be wrapped in an |
276
|
|
|
|
|
|
|
I call, since this is the most common case (testing that a result is the |
277
|
|
|
|
|
|
|
expected value). |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=cut |
280
|
|
|
|
|
|
|
sub eqv($) { |
281
|
35
|
|
|
35
|
1
|
188
|
my ($other) = @_; |
282
|
|
|
|
|
|
|
return sub { |
283
|
35
|
|
|
35
|
|
56
|
my ($got, $name) = @_; |
284
|
35
|
|
|
|
|
142
|
return is_deeply($got, $other, $name); |
285
|
35
|
|
|
|
|
177
|
}; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=item B |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
Tests whether the result differs from (is inequivalent to) I |
291
|
|
|
|
|
|
|
to Data::Compare. This is expected (hoped?) to be inverse of I. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=cut |
294
|
|
|
|
|
|
|
sub ineqv($) { |
295
|
306
|
|
|
306
|
1
|
2918
|
my ($other) = @_; |
296
|
|
|
|
|
|
|
return sub { |
297
|
306
|
|
|
306
|
|
420
|
my ($got, $name) = @_; |
298
|
306
|
|
|
|
|
844
|
return _ok(!Compare($got, $other), $name, " objects were the same"); |
299
|
306
|
|
|
|
|
2224
|
}; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=item B |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Creates a function which tests that the result is of (or inhereits from) the |
305
|
|
|
|
|
|
|
provided I (that the result's type is equivalent to I). For |
306
|
|
|
|
|
|
|
unblessed references, it checks that |
307
|
|
|
|
|
|
|
C[. For blessed references it checks that ] |
308
|
|
|
|
|
|
|
C<< $result->isa($type) >>. Results which are not references will always be |
309
|
|
|
|
|
|
|
false. |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=cut |
312
|
|
|
|
|
|
|
sub typeqv($) { |
313
|
18
|
|
|
18
|
1
|
177
|
my($type) = @_; |
314
|
|
|
|
|
|
|
return sub { |
315
|
18
|
|
|
18
|
|
27
|
my ($got, $name) = @_; |
316
|
18
|
50
|
|
|
|
37
|
return _fail($name, " result was undef") unless defined($got); |
317
|
18
|
50
|
|
|
|
92
|
return _fail($name, " result was not a ref") unless ref($got); |
318
|
18
|
|
66
|
|
|
127
|
my $ok = ref($got) eq $type || blessed($got) && $got->isa($type); |
319
|
18
|
|
|
|
|
67
|
return _ok($ok, $name, " result was not of type $type"); |
320
|
18
|
|
|
|
|
136
|
}; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=item B |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
Verifies that the test's code block died. It is unique amongst test conditions |
326
|
|
|
|
|
|
|
in that it doesn't test the result, but rather tests C<$@>. Any result other |
327
|
|
|
|
|
|
|
than a die succeeds. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=cut |
330
|
|
|
|
|
|
|
sub dies() { |
331
|
5
|
|
|
5
|
1
|
26
|
return $dies; |
332
|
|
|
|
|
|
|
}; |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=item B |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
This is the "default" condition; if no condition is given to a test then this |
337
|
|
|
|
|
|
|
condition is used. As long as the code block does not die, the test passes. |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=cut |
340
|
|
|
|
|
|
|
sub noop() { |
341
|
|
|
|
|
|
|
return sub { |
342
|
2
|
|
|
2
|
|
3
|
my ($got, $name) = @_; |
343
|
2
|
|
|
|
|
7
|
return _ok(1, $name); |
344
|
2
|
|
|
2
|
1
|
18
|
}; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=item B |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
Verifies that the result is a true value. |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=cut |
352
|
|
|
|
|
|
|
sub true() { |
353
|
|
|
|
|
|
|
return sub { |
354
|
3
|
|
|
3
|
|
5
|
my ($got, $name) = @_; |
355
|
3
|
|
|
|
|
6
|
return _ok($got, $name); |
356
|
3
|
|
|
3
|
1
|
17
|
}; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=item B |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Verifies that the result is a false value. |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=cut |
364
|
|
|
|
|
|
|
sub false() { |
365
|
|
|
|
|
|
|
return sub { |
366
|
3
|
|
|
3
|
|
6
|
my ($got, $name) = @_; |
367
|
3
|
|
|
|
|
8
|
return _ok(!$got, $name); |
368
|
3
|
|
|
3
|
1
|
18
|
}; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=item B |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
Checks that the result is defined (not undef). |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=cut |
376
|
|
|
|
|
|
|
sub isdef() { |
377
|
|
|
|
|
|
|
return sub { |
378
|
4
|
|
|
4
|
|
6
|
my ($got, $name) = @_; |
379
|
4
|
|
|
|
|
11
|
return _ok(defined($got), $name); |
380
|
4
|
|
|
4
|
1
|
20
|
}; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
=item B |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
Checks that the result is undefined. |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=cut |
388
|
|
|
|
|
|
|
sub isundef() { |
389
|
|
|
|
|
|
|
return sub { |
390
|
1
|
|
|
1
|
|
3
|
my ($got, $name) = @_; |
391
|
1
|
|
|
|
|
4
|
return _ok(!defined($got), $name); |
392
|
1
|
|
|
1
|
1
|
7
|
}; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=back |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=head1 CUSTOM TEST CONDITIONS |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
Anonymous subroutines can be used in place of the provided test conditions. |
400
|
|
|
|
|
|
|
These functions take two arguments: the test result and the test's name. Here |
401
|
|
|
|
|
|
|
are some examples: |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
use Test::More; |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
sub over21 { |
406
|
|
|
|
|
|
|
my ($result, $name) = @_; |
407
|
|
|
|
|
|
|
return cmp_ok($result, '>=', 21, $name); |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
test { $alice->age } \&over21, 'can alice drink?'; |
410
|
|
|
|
|
|
|
test { $bob->age } \&over21, 'can bob drink?'; |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
These examples are kind of clunky, but you get the idea. Using anything |
413
|
|
|
|
|
|
|
complicated will probably require reading the source, and/or learning how to |
414
|
|
|
|
|
|
|
use L. In particular, it's important to make sure |
415
|
|
|
|
|
|
|
C<< builder->level >> is set correctly. |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=head1 ETHOS |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
This package exists to address some specific concerns I've had while writing |
420
|
|
|
|
|
|
|
tests using other frameworks. As such, it has some pretty major differences from |
421
|
|
|
|
|
|
|
the other testing frameworks out there. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
Most Perl tests are written as perl scripts which test Perl code by calling |
424
|
|
|
|
|
|
|
functions or methods, and then using various Test packages to look at the |
425
|
|
|
|
|
|
|
result. This approach has some problems: |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=over |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
=item 1 |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
Test scripts can make bad assumptions or have bugs, causing problems that |
432
|
|
|
|
|
|
|
aren't obviously linked to a particular test clause and which can be hard to |
433
|
|
|
|
|
|
|
track down and fix. |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=item 2 |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
Writing defensive test scripts involves a bunch of relatively boiler-plate |
438
|
|
|
|
|
|
|
eval-blocks and C<$@> tests, as well as effectively doubling the number of tests |
439
|
|
|
|
|
|
|
that are "run" without meaningfully doubling the test coverage. |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
=item 3 |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
In some cases a small early error causes tons of test clauses to spew useless |
444
|
|
|
|
|
|
|
messages about failing; this loses sight of the basic issue that caused the |
445
|
|
|
|
|
|
|
problem (syntax error, missing module, etc). |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=back |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
Test::Functional addresses these concerns: it enables the programmer to write |
450
|
|
|
|
|
|
|
all the "meat" of the test script inside anonymous subs which are tests [1]. |
451
|
|
|
|
|
|
|
Since each test checks both that the code did not die and that the result was |
452
|
|
|
|
|
|
|
what was expected, the tester doesn't have to worry about what kind of failure |
453
|
|
|
|
|
|
|
might occur, just about the expected outcome [2]. Especially when trying to test |
454
|
|
|
|
|
|
|
other people's code (gray box testing?) this feature is invaluable. |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
The various features to prematurely end the test (using I and/or |
457
|
|
|
|
|
|
|
C<< $Test::Functional::Conf->fastout >>) can help the developer to focus on the |
458
|
|
|
|
|
|
|
problem at hand, rather than having to filter through spew [3]. This is |
459
|
|
|
|
|
|
|
especially nice during test-driven development, or when trying to increase |
460
|
|
|
|
|
|
|
coverage for an old and crufty module. |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=head1 AUTHOR |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
Erik Osheim C<< >> |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=head1 BUGS |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
The syntax takes some getting used to. |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
I should create default wrappers for things such as I and I from |
471
|
|
|
|
|
|
|
L. Currently I mostly use I but that gives less debugging |
472
|
|
|
|
|
|
|
information. |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
I wrote these tests to suit my needs, so I am sure there are cases I haven't |
475
|
|
|
|
|
|
|
thought of or encountered. Also, I'm sure I have a lot to learn about the |
476
|
|
|
|
|
|
|
intricacies of L and L. Please contact me (via |
477
|
|
|
|
|
|
|
email or L) with any comments, advice, or problems. |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
This module is based on Test::Builder::Module, and relies heavily on the work |
482
|
|
|
|
|
|
|
done by Michael Schwern. It also uses Data::Compare by David Cantrell. |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
Copyright 2009 Erik Osheim, all rights reserved. |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
489
|
|
|
|
|
|
|
under the same terms as Perl itself. |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=cut |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
1; |