Profile of Test/More.pm

← Index
NYTProf Performance Profile «line view»
For t/optimization.t
Run on Thu Jan 8 22:47:42 2015
Reported on Thu Jan 8 22:48:05 2015

Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/5.16.3/Test/More.pm
Statements | Executed 57 statements in 4.31ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 1.17ms | 11.6ms | Test::More::::BEGIN@23Test::More::BEGIN@23
1 | 1 | 1 | 76µs | 225µs | Test::More::::_evalTest::More::_eval
1 | 1 | 1 | 34µs | 626µs | Test::More::::use_okTest::More::use_ok
1 | 1 | 1 | 33µs | 33µs | Test::More::::BEGIN@3Test::More::BEGIN@3
2 | 2 | 1 | 28µs | 718µs | Test::More::::isTest::More::is
1 | 1 | 1 | 16µs | 28µs | Test::More::::BEGIN@1678Test::More::BEGIN@1678
1 | 1 | 1 | 14µs | 24µs | Test::More::::BEGIN@1389Test::More::BEGIN@1389
1 | 1 | 1 | 13µs | 27µs | Test::More::::BEGIN@1312Test::More::BEGIN@1312
1 | 1 | 1 | 13µs | 176µs | Test::More::::planTest::More::plan
1 | 1 | 1 | 9µs | 26µs | Test::More::::BEGIN@4Test::More::BEGIN@4
1 | 1 | 1 | 9µs | 14µs | Test::More::::BEGIN@5Test::More::BEGIN@5
1 | 1 | 1 | 4µs | 4µs | Test::More::::import_extraTest::More::import_extra
0 | 0 | 0 | 0s | 0s | Test::More::::BAIL_OUTTest::More::BAIL_OUT
0 | 0 | 0 | 0s | 0s | Test::More::::__ANON__[:532]Test::More::__ANON__[:532]
0 | 0 | 0 | 0s | 0s | Test::More::::__ANON__[:601]Test::More::__ANON__[:601]
0 | 0 | 0 | 0s | 0s | Test::More::::__ANON__[:689]Test::More::__ANON__[:689]
0 | 0 | 0 | 0s | 0s | Test::More::::_carpTest::More::_carp
0 | 0 | 0 | 0s | 0s | Test::More::::_deep_checkTest::More::_deep_check
0 | 0 | 0 | 0s | 0s | Test::More::::_dneTest::More::_dne
0 | 0 | 0 | 0s | 0s | Test::More::::_eq_arrayTest::More::_eq_array
0 | 0 | 0 | 0s | 0s | Test::More::::_eq_hashTest::More::_eq_hash
0 | 0 | 0 | 0s | 0s | Test::More::::_equal_nonrefsTest::More::_equal_nonrefs
0 | 0 | 0 | 0s | 0s | Test::More::::_format_stackTest::More::_format_stack
0 | 0 | 0 | 0s | 0s | Test::More::::_is_module_nameTest::More::_is_module_name
0 | 0 | 0 | 0s | 0s | Test::More::::_typeTest::More::_type
0 | 0 | 0 | 0s | 0s | Test::More::::_whoaTest::More::_whoa
0 | 0 | 0 | 0s | 0s | Test::More::::can_okTest::More::can_ok
0 | 0 | 0 | 0s | 0s | Test::More::::cmp_okTest::More::cmp_ok
0 | 0 | 0 | 0s | 0s | Test::More::::diagTest::More::diag
0 | 0 | 0 | 0s | 0s | Test::More::::done_testingTest::More::done_testing
0 | 0 | 0 | 0s | 0s | Test::More::::eq_arrayTest::More::eq_array
0 | 0 | 0 | 0s | 0s | Test::More::::eq_hashTest::More::eq_hash
0 | 0 | 0 | 0s | 0s | Test::More::::eq_setTest::More::eq_set
0 | 0 | 0 | 0s | 0s | Test::More::::explainTest::More::explain
0 | 0 | 0 | 0s | 0s | Test::More::::failTest::More::fail
0 | 0 | 0 | 0s | 0s | Test::More::::is_deeplyTest::More::is_deeply
0 | 0 | 0 | 0s | 0s | Test::More::::isa_okTest::More::isa_ok
0 | 0 | 0 | 0s | 0s | Test::More::::isntTest::More::isnt
0 | 0 | 0 | 0s | 0s | Test::More::::likeTest::More::like
0 | 0 | 0 | 0s | 0s | Test::More::::new_okTest::More::new_ok
0 | 0 | 0 | 0s | 0s | Test::More::::noteTest::More::note
0 | 0 | 0 | 0s | 0s | Test::More::::okTest::More::ok
0 | 0 | 0 | 0s | 0s | Test::More::::passTest::More::pass
0 | 0 | 0 | 0s | 0s | Test::More::::require_okTest::More::require_ok
0 | 0 | 0 | 0s | 0s | Test::More::::skipTest::More::skip
0 | 0 | 0 | 0s | 0s | Test::More::::subtestTest::More::subtest
0 | 0 | 0 | 0s | 0s | Test::More::::todo_skipTest::More::todo_skip
0 | 0 | 0 | 0s | 0s | Test::More::::unlikeTest::More::unlike

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Test::More;
2 |  |  |  |  |
3 | 2 | 68µs | 1 | 33µs | # spent 33µs within Test::More::BEGIN@3 which was called: # once (33µs+0s) by main::BEGIN@6 at line 3 use 5.006; # spent 33µs making 1 call to Test::More::BEGIN@3
4 | 2 | 26µs | 2 | 43µs | # spent 26µs (9+17) within Test::More::BEGIN@4 which was called: # once (9µs+17µs) by main::BEGIN@6 at line 4 use strict; # spent 26µs making 1 call to Test::More::BEGIN@4 # spent 17µs making 1 call to strict::import
5 | 2 | 101µs | 2 | 19µs | # spent 14µs (9+5) within Test::More::BEGIN@5 which was called: # once (9µs+5µs) by main::BEGIN@6 at line 5 use warnings; # spent 14µs making 1 call to Test::More::BEGIN@5 # spent 5µs making 1 call to warnings::import
6 |  |  |  |  |
7 |  |  |  |  | #---- perlcritic exemptions. ----#
8 |  |  |  |  |
9 |  |  |  |  | # We use a lot of subroutine prototypes
10 |  |  |  |  | ## no critic (Subroutines::ProhibitSubroutinePrototypes)
11 |  |  |  |  |
12 |  |  |  |  | # Can't use Carp because it might cause use_ok() to accidentally succeed
13 |  |  |  |  | # even though the module being used forgot to use Carp. Yes, this
14 |  |  |  |  | # actually happened.
15 |  |  |  |  | sub _carp {
16 |  |  |  |  | my( $file, $line ) = ( caller(1) )[ 1, 2 ];
17 |  |  |  |  | return warn @_, " at $file line $line\n";
18 |  |  |  |  | }
19 |  |  |  |  |
20 | 1 | 800ns |  |  | our $VERSION = '1.001002';
21 | 1 | 17µs |  |  | $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) # spent 2µs executing statements in string eval
22 |  |  |  |  |
23 | 3 | 2.72ms | 3 | 11.6ms | # spent 11.6ms (1.17+10.4) within Test::More::BEGIN@23 which was called: # once (1.17ms+10.4ms) by main::BEGIN@6 at line 23 use Test::Builder::Module 0.99; # spent 11.6ms making 1 call to Test::More::BEGIN@23 # spent 16µs making 1 call to UNIVERSAL::VERSION # spent 3µs making 1 call to Test::Builder::Module::import
24 | 1 | 8µs |  |  | our @ISA = qw(Test::Builder::Module);
25 | 1 | 5µs |  |  | our @EXPORT = qw(ok use_ok require_ok
26 |  |  |  |  | is isnt like unlike is_deeply
27 |  |  |  |  | cmp_ok
28 |  |  |  |  | skip todo todo_skip
29 |  |  |  |  | pass fail
30 |  |  |  |  | eq_array eq_hash eq_set
31 |  |  |  |  | $TODO
32 |  |  |  |  | plan
33 |  |  |  |  | done_testing
34 |  |  |  |  | can_ok isa_ok new_ok
35 |  |  |  |  | diag note explain
36 |  |  |  |  | subtest
37 |  |  |  |  | BAIL_OUT
38 |  |  |  |  | );
39 |  |  |  |  |
40 |  |  |  |  | =head1 NAME
41 |  |  |  |  |
42 |  |  |  |  | Test::More - yet another framework for writing test scripts
43 |  |  |  |  |
44 |  |  |  |  | =head1 SYNOPSIS
45 |  |  |  |  |
46 |  |  |  |  | use Test::More tests => 23;
47 |  |  |  |  | # or
48 |  |  |  |  | use Test::More skip_all => $reason;
49 |  |  |  |  | # or
50 |  |  |  |  | use Test::More; # see done_testing()
51 |  |  |  |  |
52 |  |  |  |  | require_ok( 'Some::Module' );
53 |  |  |  |  |
54 |  |  |  |  | # Various ways to say "ok"
55 |  |  |  |  | ok($got eq $expected, $test_name);
56 |  |  |  |  |
57 |  |  |  |  | is ($got, $expected, $test_name);
58 |  |  |  |  | isnt($got, $expected, $test_name);
59 |  |  |  |  |
60 |  |  |  |  | # Rather than print STDERR "# here's what went wrong\n"
61 |  |  |  |  | diag("here's what went wrong");
62 |  |  |  |  |
63 |  |  |  |  | like ($got, qr/expected/, $test_name);
64 |  |  |  |  | unlike($got, qr/expected/, $test_name);
65 |  |  |  |  |
66 |  |  |  |  | cmp_ok($got, '==', $expected, $test_name);
67 |  |  |  |  |
68 |  |  |  |  | is_deeply($got_complex_structure, $expected_complex_structure, $test_name);
69 |  |  |  |  |
70 |  |  |  |  | SKIP: {
71 |  |  |  |  | skip $why, $how_many unless $have_some_feature;
72 |  |  |  |  |
73 |  |  |  |  | ok( foo(), $test_name );
74 |  |  |  |  | is( foo(42), 23, $test_name );
75 |  |  |  |  | };
76 |  |  |  |  |
77 |  |  |  |  | TODO: {
78 |  |  |  |  | local $TODO = $why;
79 |  |  |  |  |
80 |  |  |  |  | ok( foo(), $test_name );
81 |  |  |  |  | is( foo(42), 23, $test_name );
82 |  |  |  |  | };
83 |  |  |  |  |
84 |  |  |  |  | can_ok($module, @methods);
85 |  |  |  |  | isa_ok($object, $class);
86 |  |  |  |  |
87 |  |  |  |  | pass($test_name);
88 |  |  |  |  | fail($test_name);
89 |  |  |  |  |
90 |  |  |  |  | BAIL_OUT($why);
91 |  |  |  |  |
92 |  |  |  |  | # UNIMPLEMENTED!!!
93 |  |  |  |  | my @status = Test::More::status;
94 |  |  |  |  |
95 |  |  |  |  |
96 |  |  |  |  | =head1 DESCRIPTION
97 |  |  |  |  |
98 |  |  |  |  | B<STOP!> If you're just getting started writing tests, have a look at
99 |  |  |  |  | L<Test::Simple> first. This is a drop in replacement for Test::Simple
100 |  |  |  |  | which you can switch to once you get the hang of basic testing.
101 |  |  |  |  |
102 |  |  |  |  | The purpose of this module is to provide a wide range of testing
103 |  |  |  |  | utilities. Various ways to say "ok" with better diagnostics,
104 |  |  |  |  | facilities to skip tests, test future features and compare complicated
105 |  |  |  |  | data structures. While you can do almost anything with a simple
106 |  |  |  |  | C<ok()> function, it doesn't provide good diagnostic output.
107 |  |  |  |  |
108 |  |  |  |  |
109 |  |  |  |  | =head2 I love it when a plan comes together
110 |  |  |  |  |
111 |  |  |  |  | Before anything else, you need a testing plan. This basically declares
112 |  |  |  |  | how many tests your script is going to run to protect against premature
113 |  |  |  |  | failure.
114 |  |  |  |  |
115 |  |  |  |  | The preferred way to do this is to declare a plan when you C<use Test::More>.
116 |  |  |  |  |
117 |  |  |  |  | use Test::More tests => 23;
118 |  |  |  |  |
119 |  |  |  |  | There are cases when you will not know beforehand how many tests your
120 |  |  |  |  | script is going to run. In this case, you can declare your tests at
121 |  |  |  |  | the end.
122 |  |  |  |  |
123 |  |  |  |  | use Test::More;
124 |  |  |  |  |
125 |  |  |  |  | ... run your tests ...
126 |  |  |  |  |
127 |  |  |  |  | done_testing( $number_of_tests_run );
128 |  |  |  |  |
129 |  |  |  |  | Sometimes you really don't know how many tests were run, or it's too
130 |  |  |  |  | difficult to calculate. In which case you can leave off
131 |  |  |  |  | $number_of_tests_run.
132 |  |  |  |  |
133 |  |  |  |  | In some cases, you'll want to completely skip an entire testing script.
134 |  |  |  |  |
135 |  |  |  |  | use Test::More skip_all => $skip_reason;
136 |  |  |  |  |
137 |  |  |  |  | Your script will declare a skip with the reason why you skipped and
138 |  |  |  |  | exit immediately with a zero (success). See L<Test::Harness> for
139 |  |  |  |  | details.
140 |  |  |  |  |
141 |  |  |  |  | If you want to control what functions Test::More will export, you
142 |  |  |  |  | have to use the 'import' option. For example, to import everything
143 |  |  |  |  | but 'fail', you'd do:
144 |  |  |  |  |
145 |  |  |  |  | use Test::More tests => 23, import => ['!fail'];
146 |  |  |  |  |
147 |  |  |  |  | Alternatively, you can use the plan() function. Useful for when you
148 |  |  |  |  | have to calculate the number of tests.
149 |  |  |  |  |
150 |  |  |  |  | use Test::More;
151 |  |  |  |  | plan tests => keys %Stuff * 3;
152 |  |  |  |  |
153 |  |  |  |  | or for deciding between running the tests at all:
154 |  |  |  |  |
155 |  |  |  |  | use Test::More;
156 |  |  |  |  | if( $^O eq 'MacOS' ) {
157 |  |  |  |  | plan skip_all => 'Test irrelevant on MacOS';
158 |  |  |  |  | }
159 |  |  |  |  | else {
160 |  |  |  |  | plan tests => 42;
161 |  |  |  |  | }
162 |  |  |  |  |
163 |  |  |  |  | =cut
164 |  |  |  |  |
165 |  |  |  |  | # spent 176µs (13+163) within Test::More::plan which was called: # once (13µs+163µs) by main::BEGIN@13 at line 17 of t/optimization.t sub plan {
166 | 1 | 5µs | 1 | 11µs | my $tb = Test::More->builder; # spent 11µs making 1 call to Test::Builder::Module::builder
167 |  |  |  |  |
168 | 1 | 7µs | 1 | 152µs | return $tb->plan(@_); # spent 152µs making 1 call to Test::Builder::plan
169 |  |  |  |  | }
170 |  |  |  |  |
171 |  |  |  |  | # This implements "use Test::More 'no_diag'" but the behavior is
172 |  |  |  |  | # deprecated.
173 |  |  |  |  | # spent 4µs within Test::More::import_extra which was called: # once (4µs+0s) by Test::Builder::Module::import at line 88 of Test/Builder/Module.pm sub import_extra {
174 | 1 | 500ns |  |  | my $class = shift;
175 | 1 | 300ns |  |  | my $list = shift;
176 |  |  |  |  |
177 | 1 | 500ns |  |  | my @other = ();
178 | 1 | 300ns |  |  | my $idx = 0;
179 | 1 | 1µs |  |  | while( $idx <= $#{$list} ) {
180 |  |  |  |  | my $item = $list->[$idx];
181 |  |  |  |  |
182 |  |  |  |  | if( defined $item and $item eq 'no_diag' ) {
183 |  |  |  |  | $class->builder->no_diag(1);
184 |  |  |  |  | }
185 |  |  |  |  | else {
186 |  |  |  |  | push @other, $item;
187 |  |  |  |  | }
188 |  |  |  |  |
189 |  |  |  |  | $idx++;
190 |  |  |  |  | }
191 |  |  |  |  |
192 | 1 | 500ns |  |  | @$list = @other;
193 |  |  |  |  |
194 | 1 | 4µs |  |  | return;
195 |  |  |  |  | }
196 |  |  |  |  |
197 |  |  |  |  | =over 4
198 |  |  |  |  |
199 |  |  |  |  | =item B<done_testing>
200 |  |  |  |  |
201 |  |  |  |  | done_testing();
202 |  |  |  |  | done_testing($number_of_tests);
203 |  |  |  |  |
204 |  |  |  |  | If you don't know how many tests you're going to run, you can issue
205 |  |  |  |  | the plan when you're done running tests.
206 |  |  |  |  |
207 |  |  |  |  | $number_of_tests is the same as plan(), it's the number of tests you
208 |  |  |  |  | expected to run. You can omit this, in which case the number of tests
209 |  |  |  |  | you ran doesn't matter, just the fact that your tests ran to
210 |  |  |  |  | conclusion.
211 |  |  |  |  |
212 |  |  |  |  | This is safer than and replaces the "no_plan" plan.
213 |  |  |  |  |
214 |  |  |  |  | =back
215 |  |  |  |  |
216 |  |  |  |  | =cut
217 |  |  |  |  |
218 |  |  |  |  | sub done_testing {
219 |  |  |  |  | my $tb = Test::More->builder;
220 |  |  |  |  | $tb->done_testing(@_);
221 |  |  |  |  | }
222 |  |  |  |  |
223 |  |  |  |  | =head2 Test names
224 |  |  |  |  |
225 |  |  |  |  | By convention, each test is assigned a number in order. This is
226 |  |  |  |  | largely done automatically for you. However, it's often very useful to
227 |  |  |  |  | assign a name to each test. Which would you rather see:
228 |  |  |  |  |
229 |  |  |  |  | ok 4
230 |  |  |  |  | not ok 5
231 |  |  |  |  | ok 6
232 |  |  |  |  |
233 |  |  |  |  | or
234 |  |  |  |  |
235 |  |  |  |  | ok 4 - basic multi-variable
236 |  |  |  |  | not ok 5 - simple exponential
237 |  |  |  |  | ok 6 - force == mass * acceleration
238 |  |  |  |  |
239 |  |  |  |  | The later gives you some idea of what failed. It also makes it easier
240 |  |  |  |  | to find the test in your script, simply search for "simple
241 |  |  |  |  | exponential".
242 |  |  |  |  |
243 |  |  |  |  | All test functions take a name argument. It's optional, but highly
244 |  |  |  |  | suggested that you use it.
245 |  |  |  |  |
246 |  |  |  |  | =head2 I'm ok, you're not ok.
247 |  |  |  |  |
248 |  |  |  |  | The basic purpose of this module is to print out either "ok #" or "not
249 |  |  |  |  | ok #" depending on if a given test succeeded or failed. Everything
250 |  |  |  |  | else is just gravy.
251 |  |  |  |  |
252 |  |  |  |  | All of the following print "ok" or "not ok" depending on if the test
253 |  |  |  |  | succeeded or failed. They all also return true or false,
254 |  |  |  |  | respectively.
255 |  |  |  |  |
256 |  |  |  |  | =over 4
257 |  |  |  |  |
258 |  |  |  |  | =item B<ok>
259 |  |  |  |  |
260 |  |  |  |  | ok($got eq $expected, $test_name);
261 |  |  |  |  |
262 |  |  |  |  | This simply evaluates any expression (C<$got eq $expected> is just a
263 |  |  |  |  | simple example) and uses that to determine if the test succeeded or
264 |  |  |  |  | failed. A true expression passes, a false one fails. Very simple.
265 |  |  |  |  |
266 |  |  |  |  | For example:
267 |  |  |  |  |
268 |  |  |  |  | ok( $exp{9} == 81, 'simple exponential' );
269 |  |  |  |  | ok( Film->can('db_Main'), 'set_db()' );
270 |  |  |  |  | ok( $p->tests == 4, 'saw tests' );
271 |  |  |  |  | ok( !grep(!defined $_, @items), 'all items defined' );
272 |  |  |  |  |
273 |  |  |  |  | (Mnemonic: "This is ok.")
274 |  |  |  |  |
275 |  |  |  |  | $test_name is a very short description of the test that will be printed
276 |  |  |  |  | out. It makes it very easy to find a test in your script when it fails
277 |  |  |  |  | and gives others an idea of your intentions. $test_name is optional,
278 |  |  |  |  | but we B<very> strongly encourage its use.
279 |  |  |  |  |
280 |  |  |  |  | Should an ok() fail, it will produce some diagnostics:
281 |  |  |  |  |
282 |  |  |  |  | not ok 18 - sufficient mucus
283 |  |  |  |  | # Failed test 'sufficient mucus'
284 |  |  |  |  | # in foo.t at line 42.
285 |  |  |  |  |
286 |  |  |  |  | This is the same as Test::Simple's ok() routine.
287 |  |  |  |  |
288 |  |  |  |  | =cut
289 |  |  |  |  |
290 |  |  |  |  | sub ok ($;$) {
291 |  |  |  |  | my( $test, $name ) = @_;
292 |  |  |  |  | my $tb = Test::More->builder;
293 |  |  |  |  |
294 |  |  |  |  | return $tb->ok( $test, $name );
295 |  |  |  |  | }
296 |  |  |  |  |
297 |  |  |  |  | =item B<is>
298 |  |  |  |  |
299 |  |  |  |  | =item B<isnt>
300 |  |  |  |  |
301 |  |  |  |  | is ( $got, $expected, $test_name );
302 |  |  |  |  | isnt( $got, $expected, $test_name );
303 |  |  |  |  |
304 |  |  |  |  | Similar to ok(), is() and isnt() compare their two arguments
305 |  |  |  |  | with C<eq> and C<ne> respectively and use the result of that to
306 |  |  |  |  | determine if the test succeeded or failed. So these:
307 |  |  |  |  |
308 |  |  |  |  | # Is the ultimate answer 42?
309 |  |  |  |  | is( ultimate_answer(), 42, "Meaning of Life" );
310 |  |  |  |  |
311 |  |  |  |  | # $foo isn't empty
312 |  |  |  |  | isnt( $foo, '', "Got some foo" );
313 |  |  |  |  |
314 |  |  |  |  | are similar to these:
315 |  |  |  |  |
316 |  |  |  |  | ok( ultimate_answer() eq 42, "Meaning of Life" );
317 |  |  |  |  | ok( $foo ne '', "Got some foo" );
318 |  |  |  |  |
319 |  |  |  |  | C<undef> will only ever match C<undef>. So you can test a value
320 |  |  |  |  | against C<undef> like this:
321 |  |  |  |  |
322 |  |  |  |  | is($not_defined, undef, "undefined as expected");
323 |  |  |  |  |
324 |  |  |  |  | (Mnemonic: "This is that." "This isn't that.")
325 |  |  |  |  |
326 |  |  |  |  | So why use these? They produce better diagnostics on failure. ok()
327 |  |  |  |  | cannot know what you are testing for (beyond the name), but is() and
328 |  |  |  |  | isnt() know what the test was and why it failed. For example this
329 |  |  |  |  | test:
330 |  |  |  |  |
331 |  |  |  |  | my $foo = 'waffle'; my $bar = 'yarblokos';
332 |  |  |  |  | is( $foo, $bar, 'Is foo the same as bar?' );
333 |  |  |  |  |
334 |  |  |  |  | Will produce something like this:
335 |  |  |  |  |
336 |  |  |  |  | not ok 17 - Is foo the same as bar?
337 |  |  |  |  | # Failed test 'Is foo the same as bar?'
338 |  |  |  |  | # in foo.t at line 139.
339 |  |  |  |  | # got: 'waffle'
340 |  |  |  |  | # expected: 'yarblokos'
341 |  |  |  |  |
342 |  |  |  |  | So you can figure out what went wrong without rerunning the test.
343 |  |  |  |  |
344 |  |  |  |  | You are encouraged to use is() and isnt() over ok() where possible,
345 |  |  |  |  | however do not be tempted to use them to find out if something is
346 |  |  |  |  | true or false!
347 |  |  |  |  |
348 |  |  |  |  | # XXX BAD!
349 |  |  |  |  | is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' );
350 |  |  |  |  |
351 |  |  |  |  | This does not check if C<exists $brooklyn{tree}> is true, it checks if
352 |  |  |  |  | it returns 1. Very different. Similar caveats exist for false and 0.
353 |  |  |  |  | In these cases, use ok().
354 |  |  |  |  |
355 |  |  |  |  | ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' );
356 |  |  |  |  |
357 |  |  |  |  | A simple call to isnt() usually does not provide a strong test but there
358 |  |  |  |  | are cases when you cannot say much more about a value than that it is
359 |  |  |  |  | different from some other value:
360 |  |  |  |  |
361 |  |  |  |  | new_ok $obj, "Foo";
362 |  |  |  |  |
363 |  |  |  |  | my $clone = $obj->clone;
364 |  |  |  |  | isa_ok $obj, "Foo", "Foo->clone";
365 |  |  |  |  |
366 |  |  |  |  | isnt $obj, $clone, "clone() produces a different object";
367 |  |  |  |  |
368 |  |  |  |  | For those grammatical pedants out there, there's an C<isn't()>
369 |  |  |  |  | function which is an alias of isnt().
370 |  |  |  |  |
371 |  |  |  |  | =cut
372 |  |  |  |  |
373 |  |  |  |  | # spent 718µs (28+690) within Test::More::is which was called 2 times, avg 359µs/call: # once (15µs+347µs) by main::RUNTIME at line 37 of t/optimization.t # once (13µs+344µs) by main::RUNTIME at line 71 of t/optimization.t sub is ($$;$) {
374 | 2 | 10µs | 2 | 16µs | my $tb = Test::More->builder; # spent 16µs making 2 calls to Test::Builder::Module::builder, avg 8µs/call
375 |  |  |  |  |
376 | 2 | 12µs | 2 | 674µs | return $tb->is_eq(@_); # spent 674µs making 2 calls to Test::Builder::is_eq, avg 337µs/call
377 |  |  |  |  | }
378 |  |  |  |  |
379 |  |  |  |  | sub isnt ($$;$) {
380 |  |  |  |  | my $tb = Test::More->builder;
381 |  |  |  |  |
382 |  |  |  |  | return $tb->isnt_eq(@_);
383 |  |  |  |  | }
384 |  |  |  |  |
385 | 1 | 2µs |  |  | *isn't = \&isnt;
386 |  |  |  |  |
387 |  |  |  |  | =item B<like>
388 |  |  |  |  |
389 |  |  |  |  | like( $got, qr/expected/, $test_name );
390 |  |  |  |  |
391 |  |  |  |  | Similar to ok(), like() matches $got against the regex C<qr/expected/>.
392 |  |  |  |  |
393 |  |  |  |  | So this:
394 |  |  |  |  |
395 |  |  |  |  | like($got, qr/expected/, 'this is like that');
396 |  |  |  |  |
397 |  |  |  |  | is similar to:
398 |  |  |  |  |
399 |  |  |  |  | ok( $got =~ m/expected/, 'this is like that');
400 |  |  |  |  |
401 |  |  |  |  | (Mnemonic "This is like that".)
402 |  |  |  |  |
403 |  |  |  |  | The second argument is a regular expression. It may be given as a
404 |  |  |  |  | regex reference (i.e. C<qr//>) or (for better compatibility with older
405 |  |  |  |  | perls) as a string that looks like a regex (alternative delimiters are
406 |  |  |  |  | currently not supported):
407 |  |  |  |  |
408 |  |  |  |  | like( $got, '/expected/', 'this is like that' );
409 |  |  |  |  |
410 |  |  |  |  | Regex options may be placed on the end (C<'/expected/i'>).
411 |  |  |  |  |
412 |  |  |  |  | Its advantages over ok() are similar to that of is() and isnt(). Better
413 |  |  |  |  | diagnostics on failure.
414 |  |  |  |  |
415 |  |  |  |  | =cut
416 |  |  |  |  |
417 |  |  |  |  | sub like ($$;$) {
418 |  |  |  |  | my $tb = Test::More->builder;
419 |  |  |  |  |
420 |  |  |  |  | return $tb->like(@_);
421 |  |  |  |  | }
422 |  |  |  |  |
423 |  |  |  |  | =item B<unlike>
424 |  |  |  |  |
425 |  |  |  |  | unlike( $got, qr/expected/, $test_name );
426 |  |  |  |  |
427 |  |  |  |  | Works exactly as like(), only it checks if $got B<does not> match the
428 |  |  |  |  | given pattern.
429 |  |  |  |  |
430 |  |  |  |  | =cut
431 |  |  |  |  |
432 |  |  |  |  | sub unlike ($$;$) {
433 |  |  |  |  | my $tb = Test::More->builder;
434 |  |  |  |  |
435 |  |  |  |  | return $tb->unlike(@_);
436 |  |  |  |  | }
437 |  |  |  |  |
438 |  |  |  |  | =item B<cmp_ok>
439 |  |  |  |  |
440 |  |  |  |  | cmp_ok( $got, $op, $expected, $test_name );
441 |  |  |  |  |
442 |  |  |  |  | Halfway between C<ok()> and C<is()> lies C<cmp_ok()>. This allows you
443 |  |  |  |  | to compare two arguments using any binary perl operator. The test
444 |  |  |  |  | passes if the comparison is true and fails otherwise.
445 |  |  |  |  |
446 |  |  |  |  | # ok( $got eq $expected );
447 |  |  |  |  | cmp_ok( $got, 'eq', $expected, 'this eq that' );
448 |  |  |  |  |
449 |  |  |  |  | # ok( $got == $expected );
450 |  |  |  |  | cmp_ok( $got, '==', $expected, 'this == that' );
451 |  |  |  |  |
452 |  |  |  |  | # ok( $got && $expected );
453 |  |  |  |  | cmp_ok( $got, '&&', $expected, 'this && that' );
454 |  |  |  |  | ...etc...
455 |  |  |  |  |
456 |  |  |  |  | Its advantage over ok() is when the test fails you'll know what $got
457 |  |  |  |  | and $expected were:
458 |  |  |  |  |
459 |  |  |  |  | not ok 1
460 |  |  |  |  | # Failed test in foo.t at line 12.
461 |  |  |  |  | # '23'
462 |  |  |  |  | # &&
463 |  |  |  |  | # undef
464 |  |  |  |  |
465 |  |  |  |  | It's also useful in those cases where you are comparing numbers and
466 |  |  |  |  | is()'s use of C<eq> will interfere:
467 |  |  |  |  |
468 |  |  |  |  | cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
469 |  |  |  |  |
470 |  |  |  |  | It's especially useful when comparing greater-than or smaller-than
471 |  |  |  |  | relation between values:
472 |  |  |  |  |
473 |  |  |  |  | cmp_ok( $some_value, '<=', $upper_limit );
474 |  |  |  |  |
475 |  |  |  |  |
476 |  |  |  |  | =cut
477 |  |  |  |  |
478 |  |  |  |  | sub cmp_ok($$$;$) {
479 |  |  |  |  | my $tb = Test::More->builder;
480 |  |  |  |  |
481 |  |  |  |  | return $tb->cmp_ok(@_);
482 |  |  |  |  | }
483 |  |  |  |  |
484 |  |  |  |  | =item B<can_ok>
485 |  |  |  |  |
486 |  |  |  |  | can_ok($module, @methods);
487 |  |  |  |  | can_ok($object, @methods);
488 |  |  |  |  |
489 |  |  |  |  | Checks to make sure the $module or $object can do these @methods
490 |  |  |  |  | (works with functions, too).
491 |  |  |  |  |
492 |  |  |  |  | can_ok('Foo', qw(this that whatever));
493 |  |  |  |  |
494 |  |  |  |  | is almost exactly like saying:
495 |  |  |  |  |
496 |  |  |  |  | ok( Foo->can('this') &&
497 |  |  |  |  | Foo->can('that') &&
498 |  |  |  |  | Foo->can('whatever')
499 |  |  |  |  | );
500 |  |  |  |  |
501 |  |  |  |  | only without all the typing and with a better interface. Handy for
502 |  |  |  |  | quickly testing an interface.
503 |  |  |  |  |
504 |  |  |  |  | No matter how many @methods you check, a single can_ok() call counts
505 |  |  |  |  | as one test. If you desire otherwise, use:
506 |  |  |  |  |
507 |  |  |  |  | foreach my $meth (@methods) {
508 |  |  |  |  | can_ok('Foo', $meth);
509 |  |  |  |  | }
510 |  |  |  |  |
511 |  |  |  |  | =cut
512 |  |  |  |  |
513 |  |  |  |  | sub can_ok ($@) {
514 |  |  |  |  | my( $proto, @methods ) = @_;
515 |  |  |  |  | my $class = ref $proto || $proto;
516 |  |  |  |  | my $tb = Test::More->builder;
517 |  |  |  |  |
518 |  |  |  |  | unless($class) {
519 |  |  |  |  | my $ok = $tb->ok( 0, "->can(...)" );
520 |  |  |  |  | $tb->diag(' can_ok() called with empty class or reference');
521 |  |  |  |  | return $ok;
522 |  |  |  |  | }
523 |  |  |  |  |
524 |  |  |  |  | unless(@methods) {
525 |  |  |  |  | my $ok = $tb->ok( 0, "$class->can(...)" );
526 |  |  |  |  | $tb->diag(' can_ok() called with no methods');
527 |  |  |  |  | return $ok;
528 |  |  |  |  | }
529 |  |  |  |  |
530 |  |  |  |  | my @nok = ();
531 |  |  |  |  | foreach my $method (@methods) {
532 |  |  |  |  | $tb->_try( sub { $proto->can($method) } ) or push @nok, $method;
533 |  |  |  |  | }
534 |  |  |  |  |
535 |  |  |  |  | my $name = (@methods == 1) ? "$class->can('$methods[0]')" :
536 |  |  |  |  | "$class->can(...)" ;
537 |  |  |  |  |
538 |  |  |  |  | my $ok = $tb->ok( !@nok, $name );
539 |  |  |  |  |
540 |  |  |  |  | $tb->diag( map " $class->can('$_') failed\n", @nok );
541 |  |  |  |  |
542 |  |  |  |  | return $ok;
543 |  |  |  |  | }
544 |  |  |  |  |
545 |  |  |  |  | =item B<isa_ok>
546 |  |  |  |  |
547 |  |  |  |  | isa_ok($object, $class, $object_name);
548 |  |  |  |  | isa_ok($subclass, $class, $object_name);
549 |  |  |  |  | isa_ok($ref, $type, $ref_name);
550 |  |  |  |  |
551 |  |  |  |  | Checks to see if the given C<< $object->isa($class) >>. Also checks to make
552 |  |  |  |  | sure the object was defined in the first place. Handy for this sort
553 |  |  |  |  | of thing:
554 |  |  |  |  |
555 |  |  |  |  | my $obj = Some::Module->new;
556 |  |  |  |  | isa_ok( $obj, 'Some::Module' );
557 |  |  |  |  |
558 |  |  |  |  | where you'd otherwise have to write
559 |  |  |  |  |
560 |  |  |  |  | my $obj = Some::Module->new;
561 |  |  |  |  | ok( defined $obj && $obj->isa('Some::Module') );
562 |  |  |  |  |
563 |  |  |  |  | to safeguard against your test script blowing up.
564 |  |  |  |  |
565 |  |  |  |  | You can also test a class, to make sure that it has the right ancestor:
566 |  |  |  |  |
567 |  |  |  |  | isa_ok( 'Vole', 'Rodent' );
568 |  |  |  |  |
569 |  |  |  |  | It works on references, too:
570 |  |  |  |  |
571 |  |  |  |  | isa_ok( $array_ref, 'ARRAY' );
572 |  |  |  |  |
573 |  |  |  |  | The diagnostics of this test normally just refer to 'the object'. If
574 |  |  |  |  | you'd like them to be more specific, you can supply an $object_name
575 |  |  |  |  | (for example 'Test customer').
576 |  |  |  |  |
577 |  |  |  |  | =cut
578 |  |  |  |  |
579 |  |  |  |  | sub isa_ok ($$;$) {
580 |  |  |  |  | my( $thing, $class, $thing_name ) = @_;
581 |  |  |  |  | my $tb = Test::More->builder;
582 |  |  |  |  |
583 |  |  |  |  | my $whatami;
584 |  |  |  |  | if( !defined $thing ) {
585 |  |  |  |  | $whatami = 'undef';
586 |  |  |  |  | }
587 |  |  |  |  | elsif( ref $thing ) {
588 |  |  |  |  | $whatami = 'reference';
589 |  |  |  |  |
590 |  |  |  |  | local($@,$!);
591 |  |  |  |  | require Scalar::Util;
592 |  |  |  |  | if( Scalar::Util::blessed($thing) ) {
593 |  |  |  |  | $whatami = 'object';
594 |  |  |  |  | }
595 |  |  |  |  | }
596 |  |  |  |  | else {
597 |  |  |  |  | $whatami = 'class';
598 |  |  |  |  | }
599 |  |  |  |  |
600 |  |  |  |  | # We can't use UNIVERSAL::isa because we want to honor isa() overrides
601 |  |  |  |  | my( $rslt, $error ) = $tb->_try( sub { $thing->isa($class) } );
602 |  |  |  |  |
603 |  |  |  |  | if($error) {
604 |  |  |  |  | die <<WHOA unless $error =~ /^Can't (locate|call) method "isa"/;
605 |  |  |  |  | WHOA! I tried to call ->isa on your $whatami and got some weird error.
606 |  |  |  |  | Here's the error.
607 |  |  |  |  | $error
608 |  |  |  |  | WHOA
609 |  |  |  |  | }
610 |  |  |  |  |
611 |  |  |  |  | # Special case for isa_ok( [], "ARRAY" ) and like
612 |  |  |  |  | if( $whatami eq 'reference' ) {
613 |  |  |  |  | $rslt = UNIVERSAL::isa($thing, $class);
614 |  |  |  |  | }
615 |  |  |  |  |
616 |  |  |  |  | my($diag, $name);
617 |  |  |  |  | if( defined $thing_name ) {
618 |  |  |  |  | $name = "'$thing_name' isa '$class'";
619 |  |  |  |  | $diag = defined $thing ? "'$thing_name' isn't a '$class'" : "'$thing_name' isn't defined";
620 |  |  |  |  | }
621 |  |  |  |  | elsif( $whatami eq 'object' ) {
622 |  |  |  |  | my $my_class = ref $thing;
623 |  |  |  |  | $thing_name = qq[An object of class '$my_class'];
624 |  |  |  |  | $name = "$thing_name isa '$class'";
625 |  |  |  |  | $diag = "The object of class '$my_class' isn't a '$class'";
626 |  |  |  |  | }
627 |  |  |  |  | elsif( $whatami eq 'reference' ) {
628 |  |  |  |  | my $type = ref $thing;
629 |  |  |  |  | $thing_name = qq[A reference of type '$type'];
630 |  |  |  |  | $name = "$thing_name isa '$class'";
631 |  |  |  |  | $diag = "The reference of type '$type' isn't a '$class'";
632 |  |  |  |  | }
633 |  |  |  |  | elsif( $whatami eq 'undef' ) {
634 |  |  |  |  | $thing_name = 'undef';
635 |  |  |  |  | $name = "$thing_name isa '$class'";
636 |  |  |  |  | $diag = "$thing_name isn't defined";
637 |  |  |  |  | }
638 |  |  |  |  | elsif( $whatami eq 'class' ) {
639 |  |  |  |  | $thing_name = qq[The class (or class-like) '$thing'];
640 |  |  |  |  | $name = "$thing_name isa '$class'";
641 |  |  |  |  | $diag = "$thing_name isn't a '$class'";
642 |  |  |  |  | }
643 |  |  |  |  | else {
644 |  |  |  |  | die;
645 |  |  |  |  | }
646 |  |  |  |  |
647 |  |  |  |  | my $ok;
648 |  |  |  |  | if($rslt) {
649 |  |  |  |  | $ok = $tb->ok( 1, $name );
650 |  |  |  |  | }
651 |  |  |  |  | else {
652 |  |  |  |  | $ok = $tb->ok( 0, $name );
653 |  |  |  |  | $tb->diag(" $diag\n");
654 |  |  |  |  | }
655 |  |  |  |  |
656 |  |  |  |  | return $ok;
657 |  |  |  |  | }
658 |  |  |  |  |
659 |  |  |  |  | =item B<new_ok>
660 |  |  |  |  |
661 |  |  |  |  | my $obj = new_ok( $class );
662 |  |  |  |  | my $obj = new_ok( $class => \@args );
663 |  |  |  |  | my $obj = new_ok( $class => \@args, $object_name );
664 |  |  |  |  |
665 |  |  |  |  | A convenience function which combines creating an object and calling
666 |  |  |  |  | isa_ok() on that object.
667 |  |  |  |  |
668 |  |  |  |  | It is basically equivalent to:
669 |  |  |  |  |
670 |  |  |  |  | my $obj = $class->new(@args);
671 |  |  |  |  | isa_ok $obj, $class, $object_name;
672 |  |  |  |  |
673 |  |  |  |  | If @args is not given, an empty list will be used.
674 |  |  |  |  |
675 |  |  |  |  | This function only works on new() and it assumes new() will return
676 |  |  |  |  | just a single object which isa C<$class>.
677 |  |  |  |  |
678 |  |  |  |  | =cut
679 |  |  |  |  |
680 |  |  |  |  | sub new_ok {
681 |  |  |  |  | my $tb = Test::More->builder;
682 |  |  |  |  | $tb->croak("new_ok() must be given at least a class") unless @_;
683 |  |  |  |  |
684 |  |  |  |  | my( $class, $args, $object_name ) = @_;
685 |  |  |  |  |
686 |  |  |  |  | $args ||= [];
687 |  |  |  |  |
688 |  |  |  |  | my $obj;
689 |  |  |  |  | my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } );
690 |  |  |  |  | if($success) {
691 |  |  |  |  | local $Test::Builder::Level = $Test::Builder::Level + 1;
692 |  |  |  |  | isa_ok $obj, $class, $object_name;
693 |  |  |  |  | }
694 |  |  |  |  | else {
695 |  |  |  |  | $class = 'undef' if !defined $class;
696 |  |  |  |  | $tb->ok( 0, "$class->new() died" );
697 |  |  |  |  | $tb->diag(" Error was: $error");
698 |  |  |  |  | }
699 |  |  |  |  |
700 |  |  |  |  | return $obj;
701 |  |  |  |  | }
702 |  |  |  |  |
703 |  |  |  |  | =item B<subtest>
704 |  |  |  |  |
705 |  |  |  |  | subtest $name => \&code;
706 |  |  |  |  |
707 |  |  |  |  | subtest() runs the &code as its own little test with its own plan and
708 |  |  |  |  | its own result. The main test counts this as a single test using the
709 |  |  |  |  | result of the whole subtest to determine if its ok or not ok.
710 |  |  |  |  |
711 |  |  |  |  | For example...
712 |  |  |  |  |
713 |  |  |  |  | use Test::More tests => 3;
714 |  |  |  |  |
715 |  |  |  |  | pass("First test");
716 |  |  |  |  |
717 |  |  |  |  | subtest 'An example subtest' => sub {
718 |  |  |  |  | plan tests => 2;
719 |  |  |  |  |
720 |  |  |  |  | pass("This is a subtest");
721 |  |  |  |  | pass("So is this");
722 |  |  |  |  | };
723 |  |  |  |  |
724 |  |  |  |  | pass("Third test");
725 |  |  |  |  |
726 |  |  |  |  | This would produce.
727 |  |  |  |  |
728 |  |  |  |  | 1..3
729 |  |  |  |  | ok 1 - First test
730 |  |  |  |  | # Subtest: An example subtest
731 |  |  |  |  | 1..2
732 |  |  |  |  | ok 1 - This is a subtest
733 |  |  |  |  | ok 2 - So is this
734 |  |  |  |  | ok 2 - An example subtest
735 |  |  |  |  | ok 3 - Third test
736 |  |  |  |  |
737 |  |  |  |  | A subtest may call "skip_all". No tests will be run, but the subtest is
738 |  |  |  |  | considered a skip.
739 |  |  |  |  |
740 |  |  |  |  | subtest 'skippy' => sub {
741 |  |  |  |  | plan skip_all => 'cuz I said so';
742 |  |  |  |  | pass('this test will never be run');
743 |  |  |  |  | };
744 |  |  |  |  |
745 |  |  |  |  | Returns true if the subtest passed, false otherwise.
746 |  |  |  |  |
747 |  |  |  |  | Due to how subtests work, you may omit a plan if you desire. This adds an
748 |  |  |  |  | implicit C<done_testing()> to the end of your subtest. The following two
749 |  |  |  |  | subtests are equivalent:
750 |  |  |  |  |
751 |  |  |  |  | subtest 'subtest with implicit done_testing()', sub {
752 |  |  |  |  | ok 1, 'subtests with an implicit done testing should work';
753 |  |  |  |  | ok 1, '... and support more than one test';
754 |  |  |  |  | ok 1, '... no matter how many tests are run';
755 |  |  |  |  | };
756 |  |  |  |  |
757 |  |  |  |  | subtest 'subtest with explicit done_testing()', sub {
758 |  |  |  |  | ok 1, 'subtests with an explicit done testing should work';
759 |  |  |  |  | ok 1, '... and support more than one test';
760 |  |  |  |  | ok 1, '... no matter how many tests are run';
761 |  |  |  |  | done_testing();
762 |  |  |  |  | };
763 |  |  |  |  |
764 |  |  |  |  | =cut
765 |  |  |  |  |
766 |  |  |  |  | sub subtest {
767 |  |  |  |  | my ($name, $subtests) = @_;
768 |  |  |  |  |
769 |  |  |  |  | my $tb = Test::More->builder;
770 |  |  |  |  | return $tb->subtest(@_);
771 |  |  |  |  | }
772 |  |  |  |  |
773 |  |  |  |  | =item B<pass>
774 |  |  |  |  |
775 |  |  |  |  | =item B<fail>
776 |  |  |  |  |
777 |  |  |  |  | pass($test_name);
778 |  |  |  |  | fail($test_name);
779 |  |  |  |  |
780 |  |  |  |  | Sometimes you just want to say that the tests have passed. Usually
781 |  |  |  |  | the case is you've got some complicated condition that is difficult to
782 |  |  |  |  | wedge into an ok(). In this case, you can simply use pass() (to
783 |  |  |  |  | declare the test ok) or fail (for not ok). They are synonyms for
784 |  |  |  |  | ok(1) and ok(0).
785 |  |  |  |  |
786 |  |  |  |  | Use these very, very, very sparingly.
787 |  |  |  |  |
788 |  |  |  |  | =cut
789 |  |  |  |  |
790 |  |  |  |  | sub pass (;$) {
791 |  |  |  |  | my $tb = Test::More->builder;
792 |  |  |  |  |
793 |  |  |  |  | return $tb->ok( 1, @_ );
794 |  |  |  |  | }
795 |  |  |  |  |
796 |  |  |  |  | sub fail (;$) {
797 |  |  |  |  | my $tb = Test::More->builder;
798 |  |  |  |  |
799 |  |  |  |  | return $tb->ok( 0, @_ );
800 |  |  |  |  | }
801 |  |  |  |  |
802 |  |  |  |  | =back
803 |  |  |  |  |
804 |  |  |  |  |
805 |  |  |  |  | =head2 Module tests
806 |  |  |  |  |
807 |  |  |  |  | Sometimes you want to test if a module, or a list of modules, can
808 |  |  |  |  | successfully load. For example, you'll often want a first test which
809 |  |  |  |  | simply loads all the modules in the distribution to make sure they
810 |  |  |  |  | work before going on to do more complicated testing.
811 |  |  |  |  |
812 |  |  |  |  | For such purposes we have C<use_ok> and C<require_ok>.
813 |  |  |  |  |
814 |  |  |  |  | =over 4
815 |  |  |  |  |
816 |  |  |  |  | =item B<require_ok>
817 |  |  |  |  |
818 |  |  |  |  | require_ok($module);
819 |  |  |  |  | require_ok($file);
820 |  |  |  |  |
821 |  |  |  |  | Tries to C<require> the given $module or $file. If it loads
822 |  |  |  |  | successfully, the test will pass. Otherwise it fails and displays the
823 |  |  |  |  | load error.
824 |  |  |  |  |
825 |  |  |  |  | C<require_ok> will guess whether the input is a module name or a
826 |  |  |  |  | filename.
827 |  |  |  |  |
828 |  |  |  |  | No exception will be thrown if the load fails.
829 |  |  |  |  |
830 |  |  |  |  | # require Some::Module
831 |  |  |  |  | require_ok "Some::Module";
832 |  |  |  |  |
833 |  |  |  |  | # require "Some/File.pl";
834 |  |  |  |  | require_ok "Some/File.pl";
835 |  |  |  |  |
836 |  |  |  |  | # stop testing if any of your modules will not load
837 |  |  |  |  | for my $module (@module) {
838 |  |  |  |  | require_ok $module or BAIL_OUT "Can't load $module";
839 |  |  |  |  | }
840 |  |  |  |  |
841 |  |  |  |  | =cut
842 |  |  |  |  |
843 |  |  |  |  | sub require_ok ($) {
844 |  |  |  |  | my($module) = shift;
845 |  |  |  |  | my $tb = Test::More->builder;
846 |  |  |  |  |
847 |  |  |  |  | my $pack = caller;
848 |  |  |  |  |
849 |  |  |  |  | # Try to determine if we've been given a module name or file.
850 |  |  |  |  | # Module names must be barewords, files not.
851 |  |  |  |  | $module = qq['$module'] unless _is_module_name($module);
852 |  |  |  |  |
853 |  |  |  |  | my $code = <<REQUIRE;
854 |  |  |  |  | package $pack;
855 |  |  |  |  | require $module;
856 |  |  |  |  | 1;
857 |  |  |  |  | REQUIRE
858 |  |  |  |  |
859 |  |  |  |  | my( $eval_result, $eval_error ) = _eval($code);
860 |  |  |  |  | my $ok = $tb->ok( $eval_result, "require $module;" );
861 |  |  |  |  |
862 |  |  |  |  | unless($ok) {
863 |  |  |  |  | chomp $eval_error;
864 |  |  |  |  | $tb->diag(<<DIAGNOSTIC);
865 |  |  |  |  | Tried to require '$module'.
866 |  |  |  |  | Error: $eval_error
867 |  |  |  |  | DIAGNOSTIC
868 |  |  |  |  |
869 |  |  |  |  | }
870 |  |  |  |  |
871 |  |  |  |  | return $ok;
872 |  |  |  |  | }
873 |  |  |  |  |
874 |  |  |  |  | sub _is_module_name {
875 |  |  |  |  | my $module = shift;
876 |  |  |  |  |
877 |  |  |  |  | # Module names start with a letter.
878 |  |  |  |  | # End with an alphanumeric.
879 |  |  |  |  | # The rest is an alphanumeric or ::
880 |  |  |  |  | $module =~ s/\b::\b//g;
881 |  |  |  |  |
882 |  |  |  |  | return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
883 |  |  |  |  | }
884 |  |  |  |  |
885 |  |  |  |  |
886 |  |  |  |  | =item B<use_ok>
887 |  |  |  |  |
888 |  |  |  |  | BEGIN { use_ok($module); }
889 |  |  |  |  | BEGIN { use_ok($module, @imports); }
890 |  |  |  |  |
891 |  |  |  |  | Like C<require_ok>, but it will C<use> the $module in question and
892 |  |  |  |  | only loads modules, not files.
893 |  |  |  |  |
894 |  |  |  |  | If you just want to test a module can be loaded, use C<require_ok>.
895 |  |  |  |  |
896 |  |  |  |  | If you just want to load a module in a test, we recommend simply using
897 |  |  |  |  | C<use> directly. It will cause the test to stop.
898 |  |  |  |  |
899 |  |  |  |  | It's recommended that you run use_ok() inside a BEGIN block so its
900 |  |  |  |  | functions are exported at compile-time and prototypes are properly
901 |  |  |  |  | honored.
902 |  |  |  |  |
903 |  |  |  |  | If @imports are given, they are passed through to the use. So this:
904 |  |  |  |  |
905 |  |  |  |  | BEGIN { use_ok('Some::Module', qw(foo bar)) }
906 |  |  |  |  |
907 |  |  |  |  | is like doing this:
908 |  |  |  |  |
909 |  |  |  |  | use Some::Module qw(foo bar);
910 |  |  |  |  |
911 |  |  |  |  | Version numbers can be checked like so:
912 |  |  |  |  |
913 |  |  |  |  | # Just like "use Some::Module 1.02"
914 |  |  |  |  | BEGIN { use_ok('Some::Module', 1.02) }
915 |  |  |  |  |
916 |  |  |  |  | Don't try to do this:
917 |  |  |  |  |
918 |  |  |  |  | BEGIN {
919 |  |  |  |  | use_ok('Some::Module');
920 |  |  |  |  |
921 |  |  |  |  | ...some code that depends on the use...
922 |  |  |  |  | ...happening at compile time...
923 |  |  |  |  | }
924 |  |  |  |  |
925 |  |  |  |  | because the notion of "compile-time" is relative. Instead, you want:
926 |  |  |  |  |
927 |  |  |  |  | BEGIN { use_ok('Some::Module') }
928 |  |  |  |  | BEGIN { ...some code that depends on the use... }
929 |  |  |  |  |
930 |  |  |  |  | If you want the equivalent of C<use Foo ()>, use a module but not
931 |  |  |  |  | import anything, use C<require_ok>.
932 |  |  |  |  |
933 |  |  |  |  | BEGIN { require_ok "Foo" }
934 |  |  |  |  |
935 |  |  |  |  | =cut
936 |  |  |  |  |
937 |  |  |  |  | # spent 626µs (34+592) within Test::More::use_ok which was called: # once (34µs+592µs) by main::RUNTIME at line 21 of t/optimization.t sub use_ok ($;@) {
938 | 1 | 2µs |  |  | my( $module, @imports ) = @_;
939 | 1 | 800ns |  |  | @imports = () unless @imports;
940 | 1 | 4µs | 1 | 10µs | my $tb = Test::More->builder; # spent 10µs making 1 call to Test::Builder::Module::builder
941 |  |  |  |  |
942 | 1 | 2µs |  |  | my( $pack, $filename, $line ) = caller;
943 | 1 | 900ns |  |  | $filename =~ y/\n\r/_/; # so it doesn't run off the "#line $line $f" line
944 |  |  |  |  |
945 | 1 | 300ns |  |  | my $code;
946 | 1 | 1µs |  |  | if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
947 |  |  |  |  | # probably a version check. Perl needs to see the bare number
948 |  |  |  |  | # for it to work with non-Exporter based modules.
949 |  |  |  |  | $code = <<USE;
950 |  |  |  |  | package $pack;
951 |  |  |  |  |
952 |  |  |  |  | #line $line $filename
953 |  |  |  |  | use $module $imports[0];
954 |  |  |  |  | 1;
955 |  |  |  |  | USE
956 |  |  |  |  | }
957 |  |  |  |  | else {
958 | 1 | 3µs |  |  | $code = <<USE;
959 |  |  |  |  | package $pack;
960 |  |  |  |  |
961 |  |  |  |  | #line $line $filename
962 |  |  |  |  | use $module \@{\$args[0]};
963 |  |  |  |  | 1;
964 |  |  |  |  | USE
965 |  |  |  |  | }
966 |  |  |  |  |
967 | 1 | 3µs | 1 | 225µs | my( $eval_result, $eval_error ) = _eval( $code, \@imports ); # spent 225µs making 1 call to Test::More::_eval
968 | 1 | 4µs | 1 | 357µs | my $ok = $tb->ok( $eval_result, "use $module;" ); # spent 357µs making 1 call to Test::Builder::ok
969 |  |  |  |  |
970 | 1 | 200ns |  |  | unless($ok) {
971 |  |  |  |  | chomp $eval_error;
972 |  |  |  |  | $@ =~ s{^BEGIN failed--compilation aborted at .*$}
973 |  |  |  |  | {BEGIN failed--compilation aborted at $filename line $line.}m;
974 |  |  |  |  | $tb->diag(<<DIAGNOSTIC);
975 |  |  |  |  | Tried to use '$module'.
976 |  |  |  |  | Error: $eval_error
977 |  |  |  |  | DIAGNOSTIC
978 |  |  |  |  |
979 |  |  |  |  | }
980 |  |  |  |  |
981 | 1 | 4µs |  |  | return $ok;
982 |  |  |  |  | }
983 |  |  |  |  |
984 |  |  |  |  | # spent 225µs (76+149) within Test::More::_eval which was called: # once (76µs+149µs) by Test::More::use_ok at line 967 sub _eval {
985 | 1 | 1µs |  |  | my( $code, @args ) = @_;
986 |  |  |  |  |
987 |  |  |  |  | # Work around oddities surrounding resetting of $@ by immediately
988 |  |  |  |  | # storing it.
989 | 1 | 400ns |  |  | my( $sigdie, $eval_result, $eval_error );
990 |  |  |  |  | {
991 | 2 | 5µs |  |  | local( $@, $!, $SIG{__DIE__} ); # isolate eval
992 | 1 | 49µs |  |  | $eval_result = eval $code; ## no critic (BuiltinFunctions::ProhibitStringyEval)
993 | 1 | 700ns |  |  | $eval_error = $@;
994 | 1 | 4µs |  |  | $sigdie = $SIG{__DIE__} || undef;
995 |  |  |  |  | }
996 |  |  |  |  | # make sure that $code got a chance to set $SIG{__DIE__}
997 | 1 | 400ns |  |  | $SIG{__DIE__} = $sigdie if defined $sigdie;
998 |  |  |  |  |
999 | 1 | 6µs |  |  | return( $eval_result, $eval_error );
1000 |  |  |  |  | }
1001 |  |  |  |  |
1002 |  |  |  |  |
1003 |  |  |  |  | =back
1004 |  |  |  |  |
1005 |  |  |  |  |
1006 |  |  |  |  | =head2 Complex data structures
1007 |  |  |  |  |
1008 |  |  |  |  | Not everything is a simple eq check or regex. There are times you
1009 |  |  |  |  | need to see if two data structures are equivalent. For these
1010 |  |  |  |  | instances Test::More provides a handful of useful functions.
1011 |  |  |  |  |
1012 |  |  |  |  | B<NOTE> I'm not quite sure what will happen with filehandles.
1013 |  |  |  |  |
1014 |  |  |  |  | =over 4
1015 |  |  |  |  |
1016 |  |  |  |  | =item B<is_deeply>
1017 |  |  |  |  |
1018 |  |  |  |  | is_deeply( $got, $expected, $test_name );
1019 |  |  |  |  |
1020 |  |  |  |  | Similar to is(), except that if $got and $expected are references, it
1021 |  |  |  |  | does a deep comparison walking each data structure to see if they are
1022 |  |  |  |  | equivalent. If the two structures are different, it will display the
1023 |  |  |  |  | place where they start differing.
1024 |  |  |  |  |
1025 |  |  |  |  | is_deeply() compares the dereferenced values of references, the
1026 |  |  |  |  | references themselves (except for their type) are ignored. This means
1027 |  |  |  |  | aspects such as blessing and ties are not considered "different".
1028 |  |  |  |  |
1029 |  |  |  |  | is_deeply() currently has very limited handling of function reference
1030 |  |  |  |  | and globs. It merely checks if they have the same referent. This may
1031 |  |  |  |  | improve in the future.
1032 |  |  |  |  |
1033 |  |  |  |  | L<Test::Differences> and L<Test::Deep> provide more in-depth functionality
1034 |  |  |  |  | along these lines.
1035 |  |  |  |  |
1036 |  |  |  |  | =cut
1037 |  |  |  |  |
1038 | 1 | 500ns |  |  | our( @Data_Stack, %Refs_Seen );
1039 | 1 | 10µs |  |  | my $DNE = bless [], 'Does::Not::Exist';
1040 |  |  |  |  |
1041 |  |  |  |  | sub _dne {
1042 |  |  |  |  | return ref $_[0] eq ref $DNE;
1043 |  |  |  |  | }
1044 |  |  |  |  |
1045 |  |  |  |  | ## no critic (Subroutines::RequireArgUnpacking)
1046 |  |  |  |  | sub is_deeply {
1047 |  |  |  |  | my $tb = Test::More->builder;
1048 |  |  |  |  |
1049 |  |  |  |  | unless( @_ == 2 or @_ == 3 ) {
1050 |  |  |  |  | my $msg = <<'WARNING';
1051 |  |  |  |  | is_deeply() takes two or three args, you gave %d.
1052 |  |  |  |  | This usually means you passed an array or hash instead
1053 |  |  |  |  | of a reference to it
1054 |  |  |  |  | WARNING
1055 |  |  |  |  | chop $msg; # clip off newline so carp() will put in line/file
1056 |  |  |  |  |
1057 |  |  |  |  | _carp sprintf $msg, scalar @_;
1058 |  |  |  |  |
1059 |  |  |  |  | return $tb->ok(0);
1060 |  |  |  |  | }
1061 |  |  |  |  |
1062 |  |  |  |  | my( $got, $expected, $name ) = @_;
1063 |  |  |  |  |
1064 |  |  |  |  | $tb->_unoverload_str( \$expected, \$got );
1065 |  |  |  |  |
1066 |  |  |  |  | my $ok;
1067 |  |  |  |  | if( !ref $got and !ref $expected ) { # neither is a reference
1068 |  |  |  |  | $ok = $tb->is_eq( $got, $expected, $name );
1069 |  |  |  |  | }
1070 |  |  |  |  | elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't
1071 |  |  |  |  | $ok = $tb->ok( 0, $name );
1072 |  |  |  |  | $tb->diag( _format_stack({ vals => [ $got, $expected ] }) );
1073 |  |  |  |  | }
1074 |  |  |  |  | else { # both references
1075 |  |  |  |  | local @Data_Stack = ();
1076 |  |  |  |  | if( _deep_check( $got, $expected ) ) {
1077 |  |  |  |  | $ok = $tb->ok( 1, $name );
1078 |  |  |  |  | }
1079 |  |  |  |  | else {
1080 |  |  |  |  | $ok = $tb->ok( 0, $name );
1081 |  |  |  |  | $tb->diag( _format_stack(@Data_Stack) );
1082 |  |  |  |  | }
1083 |  |  |  |  | }
1084 |  |  |  |  |
1085 |  |  |  |  | return $ok;
1086 |  |  |  |  | }
1087 |  |  |  |  |
1088 |  |  |  |  | sub _format_stack {
1089 |  |  |  |  | my(@Stack) = @_;
1090 |  |  |  |  |
1091 |  |  |  |  | my $var = '$FOO';
1092 |  |  |  |  | my $did_arrow = 0;
1093 |  |  |  |  | foreach my $entry (@Stack) {
1094 |  |  |  |  | my $type = $entry->{type} || '';
1095 |  |  |  |  | my $idx = $entry->{'idx'};
1096 |  |  |  |  | if( $type eq 'HASH' ) {
1097 |  |  |  |  | $var .= "->" unless $did_arrow++;
1098 |  |  |  |  | $var .= "{$idx}";
1099 |  |  |  |  | }
1100 |  |  |  |  | elsif( $type eq 'ARRAY' ) {
1101 |  |  |  |  | $var .= "->" unless $did_arrow++;
1102 |  |  |  |  | $var .= "[$idx]";
1103 |  |  |  |  | }
1104 |  |  |  |  | elsif( $type eq 'REF' ) {
1105 |  |  |  |  | $var = "\${$var}";
1106 |  |  |  |  | }
1107 |  |  |  |  | }
1108 |  |  |  |  |
1109 |  |  |  |  | my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ];
1110 |  |  |  |  | my @vars = ();
1111 |  |  |  |  | ( $vars[0] = $var ) =~ s/\$FOO/ \$got/;
1112 |  |  |  |  | ( $vars[1] = $var ) =~ s/\$FOO/\$expected/;
1113 |  |  |  |  |
1114 |  |  |  |  | my $out = "Structures begin differing at:\n";
1115 |  |  |  |  | foreach my $idx ( 0 .. $#vals ) {
1116 |  |  |  |  | my $val = $vals[$idx];
1117 |  |  |  |  | $vals[$idx]
1118 |  |  |  |  | = !defined $val ? 'undef'
1119 |  |  |  |  | : _dne($val) ? "Does not exist"
1120 |  |  |  |  | : ref $val ? "$val"
1121 |  |  |  |  | : "'$val'";
1122 |  |  |  |  | }
1123 |  |  |  |  |
1124 |  |  |  |  | $out .= "$vars[0] = $vals[0]\n";
1125 |  |  |  |  | $out .= "$vars[1] = $vals[1]\n";
1126 |  |  |  |  |
1127 |  |  |  |  | $out =~ s/^/ /msg;
1128 |  |  |  |  | return $out;
1129 |  |  |  |  | }
1130 |  |  |  |  |
1131 |  |  |  |  | sub _type {
1132 |  |  |  |  | my $thing = shift;
1133 |  |  |  |  |
1134 |  |  |  |  | return '' if !ref $thing;
1135 |  |  |  |  |
1136 |  |  |  |  | for my $type (qw(Regexp ARRAY HASH REF SCALAR GLOB CODE)) {
1137 |  |  |  |  | return $type if UNIVERSAL::isa( $thing, $type );
1138 |  |  |  |  | }
1139 |  |  |  |  |
1140 |  |  |  |  | return '';
1141 |  |  |  |  | }
1142 |  |  |  |  |
1143 |  |  |  |  | =back
1144 |  |  |  |  |
1145 |  |  |  |  |
1146 |  |  |  |  | =head2 Diagnostics
1147 |  |  |  |  |
1148 |  |  |  |  | If you pick the right test function, you'll usually get a good idea of
1149 |  |  |  |  | what went wrong when it failed. But sometimes it doesn't work out
1150 |  |  |  |  | that way. So here we have ways for you to write your own diagnostic
1151 |  |  |  |  | messages which are safer than just C<print STDERR>.
1152 |  |  |  |  |
1153 |  |  |  |  | =over 4
1154 |  |  |  |  |
1155 |  |  |  |  | =item B<diag>
1156 |  |  |  |  |
1157 |  |  |  |  | diag(@diagnostic_message);
1158 |  |  |  |  |
1159 |  |  |  |  | Prints a diagnostic message which is guaranteed not to interfere with
1160 |  |  |  |  | test output. Like C<print> @diagnostic_message is simply concatenated
1161 |  |  |  |  | together.
1162 |  |  |  |  |
1163 |  |  |  |  | Returns false, so as to preserve failure.
1164 |  |  |  |  |
1165 |  |  |  |  | Handy for this sort of thing:
1166 |  |  |  |  |
1167 |  |  |  |  | ok( grep(/foo/, @users), "There's a foo user" ) or
1168 |  |  |  |  | diag("Since there's no foo, check that /etc/bar is set up right");
1169 |  |  |  |  |
1170 |  |  |  |  | which would produce:
1171 |  |  |  |  |
1172 |  |  |  |  | not ok 42 - There's a foo user
1173 |  |  |  |  | # Failed test 'There's a foo user'
1174 |  |  |  |  | # in foo.t at line 52.
1175 |  |  |  |  | # Since there's no foo, check that /etc/bar is set up right.
1176 |  |  |  |  |
1177 |  |  |  |  | You might remember C<ok() or diag()> with the mnemonic C<open() or
1178 |  |  |  |  | die()>.
1179 |  |  |  |  |
1180 |  |  |  |  | B<NOTE> The exact formatting of the diagnostic output is still
1181 |  |  |  |  | changing, but it is guaranteed that whatever you throw at it won't
1182 |  |  |  |  | interfere with the test.
1183 |  |  |  |  |
1184 |  |  |  |  | =item B<note>
1185 |  |  |  |  |
1186 |  |  |  |  | note(@diagnostic_message);
1187 |  |  |  |  |
1188 |  |  |  |  | Like diag(), except the message will not be seen when the test is run
1189 |  |  |  |  | in a harness. It will only be visible in the verbose TAP stream.
1190 |  |  |  |  |
1191 |  |  |  |  | Handy for putting in notes which might be useful for debugging, but
1192 |  |  |  |  | don't indicate a problem.
1193 |  |  |  |  |
1194 |  |  |  |  | note("Tempfile is $tempfile");
1195 |  |  |  |  |
1196 |  |  |  |  | =cut
1197 |  |  |  |  |
1198 |  |  |  |  | sub diag {
1199 |  |  |  |  | return Test::More->builder->diag(@_);
1200 |  |  |  |  | }
1201 |  |  |  |  |
1202 |  |  |  |  | sub note {
1203 |  |  |  |  | return Test::More->builder->note(@_);
1204 |  |  |  |  | }
1205 |  |  |  |  |
1206 |  |  |  |  | =item B<explain>
1207 |  |  |  |  |
1208 |  |  |  |  | my @dump = explain @diagnostic_message;
1209 |  |  |  |  |
1210 |  |  |  |  | Will dump the contents of any references in a human readable format.
1211 |  |  |  |  | Usually you want to pass this into C<note> or C<diag>.
1212 |  |  |  |  |
1213 |  |  |  |  | Handy for things like...
1214 |  |  |  |  |
1215 |  |  |  |  | is_deeply($have, $want) || diag explain $have;
1216 |  |  |  |  |
1217 |  |  |  |  | or
1218 |  |  |  |  |
1219 |  |  |  |  | note explain \%args;
1220 |  |  |  |  | Some::Class->method(%args);
1221 |  |  |  |  |
1222 |  |  |  |  | =cut
1223 |  |  |  |  |
1224 |  |  |  |  | sub explain {
1225 |  |  |  |  | return Test::More->builder->explain(@_);
1226 |  |  |  |  | }
1227 |  |  |  |  |
1228 |  |  |  |  | =back
1229 |  |  |  |  |
1230 |  |  |  |  |
1231 |  |  |  |  | =head2 Conditional tests
1232 |  |  |  |  |
1233 |  |  |  |  | Sometimes running a test under certain conditions will cause the
1234 |  |  |  |  | test script to die. A certain function or method isn't implemented
1235 |  |  |  |  | (such as fork() on MacOS), some resource isn't available (like a
1236 |  |  |  |  | net connection) or a module isn't available. In these cases it's
1237 |  |  |  |  | necessary to skip tests, or declare that they are supposed to fail
1238 |  |  |  |  | but will work in the future (a todo test).
1239 |  |  |  |  |
1240 |  |  |  |  | For more details on the mechanics of skip and todo tests see
1241 |  |  |  |  | L<Test::Harness>.
1242 |  |  |  |  |
1243 |  |  |  |  | The way Test::More handles this is with a named block. Basically, a
1244 |  |  |  |  | block of tests which can be skipped over or made todo. It's best if I
1245 |  |  |  |  | just show you...
1246 |  |  |  |  |
1247 |  |  |  |  | =over 4
1248 |  |  |  |  |
1249 |  |  |  |  | =item B<SKIP: BLOCK>
1250 |  |  |  |  |
1251 |  |  |  |  | SKIP: {
1252 |  |  |  |  | skip $why, $how_many if $condition;
1253 |  |  |  |  |
1254 |  |  |  |  | ...normal testing code goes here...
1255 |  |  |  |  | }
1256 |  |  |  |  |
1257 |  |  |  |  | This declares a block of tests that might be skipped, $how_many tests
1258 |  |  |  |  | there are, $why and under what $condition to skip them. An example is
1259 |  |  |  |  | the easiest way to illustrate:
1260 |  |  |  |  |
1261 |  |  |  |  | SKIP: {
1262 |  |  |  |  | eval { require HTML::Lint };
1263 |  |  |  |  |
1264 |  |  |  |  | skip "HTML::Lint not installed", 2 if $@;
1265 |  |  |  |  |
1266 |  |  |  |  | my $lint = new HTML::Lint;
1267 |  |  |  |  | isa_ok( $lint, "HTML::Lint" );
1268 |  |  |  |  |
1269 |  |  |  |  | $lint->parse( $html );
1270 |  |  |  |  | is( $lint->errors, 0, "No errors found in HTML" );
1271 |  |  |  |  | }
1272 |  |  |  |  |
1273 |  |  |  |  | If the user does not have HTML::Lint installed, the whole block of
1274 |  |  |  |  | code I<won't be run at all>. Test::More will output special ok's
1275 |  |  |  |  | which Test::Harness interprets as skipped, but passing, tests.
1276 |  |  |  |  |
1277 |  |  |  |  | It's important that $how_many accurately reflects the number of tests
1278 |  |  |  |  | in the SKIP block so the # of tests run will match up with your plan.
1279 |  |  |  |  | If your plan is C<no_plan> $how_many is optional and will default to 1.
1280 |  |  |  |  |
1281 |  |  |  |  | It's perfectly safe to nest SKIP blocks. Each SKIP block must have
1282 |  |  |  |  | the label C<SKIP>, or Test::More can't work its magic.
1283 |  |  |  |  |
1284 |  |  |  |  | You don't skip tests which are failing because there's a bug in your
1285 |  |  |  |  | program, or for which you don't yet have code written. For that you
1286 |  |  |  |  | use TODO. Read on.
1287 |  |  |  |  |
1288 |  |  |  |  | =cut
1289 |  |  |  |  |
1290 |  |  |  |  | ## no critic (Subroutines::RequireFinalReturn)
1291 |  |  |  |  | sub skip {
1292 |  |  |  |  | my( $why, $how_many ) = @_;
1293 |  |  |  |  | my $tb = Test::More->builder;
1294 |  |  |  |  |
1295 |  |  |  |  | unless( defined $how_many ) {
1296 |  |  |  |  | # $how_many can only be avoided when no_plan is in use.
1297 |  |  |  |  | _carp "skip() needs to know \$how_many tests are in the block"
1298 |  |  |  |  | unless $tb->has_plan eq 'no_plan';
1299 |  |  |  |  | $how_many = 1;
1300 |  |  |  |  | }
1301 |  |  |  |  |
1302 |  |  |  |  | if( defined $how_many and $how_many =~ /\D/ ) {
1303 |  |  |  |  | _carp
1304 |  |  |  |  | "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?";
1305 |  |  |  |  | $how_many = 1;
1306 |  |  |  |  | }
1307 |  |  |  |  |
1308 |  |  |  |  | for( 1 .. $how_many ) {
1309 |  |  |  |  | $tb->skip($why);
1310 |  |  |  |  | }
1311 |  |  |  |  |
1312 | 2 | 129µs | 2 | 40µs | # spent 27µs (13+14) within Test::More::BEGIN@1312 which was called: # once (13µs+14µs) by main::BEGIN@6 at line 1312 no warnings 'exiting'; # spent 27µs making 1 call to Test::More::BEGIN@1312 # spent 14µs making 1 call to warnings::unimport
1313 |  |  |  |  | last SKIP;
1314 |  |  |  |  | }
1315 |  |  |  |  |
1316 |  |  |  |  | =item B<TODO: BLOCK>
1317 |  |  |  |  |
1318 |  |  |  |  | TODO: {
1319 |  |  |  |  | local $TODO = $why if $condition;
1320 |  |  |  |  |
1321 |  |  |  |  | ...normal testing code goes here...
1322 |  |  |  |  | }
1323 |  |  |  |  |
1324 |  |  |  |  | Declares a block of tests you expect to fail and $why. Perhaps it's
1325 |  |  |  |  | because you haven't fixed a bug or haven't finished a new feature:
1326 |  |  |  |  |
1327 |  |  |  |  | TODO: {
1328 |  |  |  |  | local $TODO = "URI::Geller not finished";
1329 |  |  |  |  |
1330 |  |  |  |  | my $card = "Eight of clubs";
1331 |  |  |  |  | is( URI::Geller->your_card, $card, 'Is THIS your card?' );
1332 |  |  |  |  |
1333 |  |  |  |  | my $spoon;
1334 |  |  |  |  | URI::Geller->bend_spoon;
1335 |  |  |  |  | is( $spoon, 'bent', "Spoon bending, that's original" );
1336 |  |  |  |  | }
1337 |  |  |  |  |
1338 |  |  |  |  | With a todo block, the tests inside are expected to fail. Test::More
1339 |  |  |  |  | will run the tests normally, but print out special flags indicating
1340 |  |  |  |  | they are "todo". Test::Harness will interpret failures as being ok.
1341 |  |  |  |  | Should anything succeed, it will report it as an unexpected success.
1342 |  |  |  |  | You then know the thing you had todo is done and can remove the
1343 |  |  |  |  | TODO flag.
1344 |  |  |  |  |
1345 |  |  |  |  | The nice part about todo tests, as opposed to simply commenting out a
1346 |  |  |  |  | block of tests, is it's like having a programmatic todo list. You know
1347 |  |  |  |  | how much work is left to be done, you're aware of what bugs there are,
1348 |  |  |  |  | and you'll know immediately when they're fixed.
1349 |  |  |  |  |
1350 |  |  |  |  | Once a todo test starts succeeding, simply move it outside the block.
1351 |  |  |  |  | When the block is empty, delete it.
1352 |  |  |  |  |
1353 |  |  |  |  |
1354 |  |  |  |  | =item B<todo_skip>
1355 |  |  |  |  |
1356 |  |  |  |  | TODO: {
1357 |  |  |  |  | todo_skip $why, $how_many if $condition;
1358 |  |  |  |  |
1359 |  |  |  |  | ...normal testing code...
1360 |  |  |  |  | }
1361 |  |  |  |  |
1362 |  |  |  |  | With todo tests, it's best to have the tests actually run. That way
1363 |  |  |  |  | you'll know when they start passing. Sometimes this isn't possible.
1364 |  |  |  |  | Often a failing test will cause the whole program to die or hang, even
1365 |  |  |  |  | inside an C<eval BLOCK> with and using C<alarm>. In these extreme
1366 |  |  |  |  | cases you have no choice but to skip over the broken tests entirely.
1367 |  |  |  |  |
1368 |  |  |  |  | The syntax and behavior is similar to a C<SKIP: BLOCK> except the
1369 |  |  |  |  | tests will be marked as failing but todo. Test::Harness will
1370 |  |  |  |  | interpret them as passing.
1371 |  |  |  |  |
1372 |  |  |  |  | =cut
1373 |  |  |  |  |
1374 |  |  |  |  | sub todo_skip {
1375 |  |  |  |  | my( $why, $how_many ) = @_;
1376 |  |  |  |  | my $tb = Test::More->builder;
1377 |  |  |  |  |
1378 |  |  |  |  | unless( defined $how_many ) {
1379 |  |  |  |  | # $how_many can only be avoided when no_plan is in use.
1380 |  |  |  |  | _carp "todo_skip() needs to know \$how_many tests are in the block"
1381 |  |  |  |  | unless $tb->has_plan eq 'no_plan';
1382 |  |  |  |  | $how_many = 1;
1383 |  |  |  |  | }
1384 |  |  |  |  |
1385 |  |  |  |  | for( 1 .. $how_many ) {
1386 |  |  |  |  | $tb->todo_skip($why);
1387 |  |  |  |  | }
1388 |  |  |  |  |
1389 | 2 | 913µs | 2 | 35µs | # spent 24µs (14+11) within Test::More::BEGIN@1389 which was called: # once (14µs+11µs) by main::BEGIN@6 at line 1389 no warnings 'exiting'; # spent 24µs making 1 call to Test::More::BEGIN@1389 # spent 11µs making 1 call to warnings::unimport
1390 |  |  |  |  | last TODO;
1391 |  |  |  |  | }
1392 |  |  |  |  |
1393 |  |  |  |  | =item When do I use SKIP vs. TODO?
1394 |  |  |  |  |
1395 |  |  |  |  | B<If it's something the user might not be able to do>, use SKIP.
1396 |  |  |  |  | This includes optional modules that aren't installed, running under
1397 |  |  |  |  | an OS that doesn't have some feature (like fork() or symlinks), or maybe
1398 |  |  |  |  | you need an Internet connection and one isn't available.
1399 |  |  |  |  |
1400 |  |  |  |  | B<If it's something the programmer hasn't done yet>, use TODO. This
1401 |  |  |  |  | is for any code you haven't written yet, or bugs you have yet to fix,
1402 |  |  |  |  | but want to put tests in your testing script (always a good idea).
1403 |  |  |  |  |
1404 |  |  |  |  |
1405 |  |  |  |  | =back
1406 |  |  |  |  |
1407 |  |  |  |  |
1408 |  |  |  |  | =head2 Test control
1409 |  |  |  |  |
1410 |  |  |  |  | =over 4
1411 |  |  |  |  |
1412 |  |  |  |  | =item B<BAIL_OUT>
1413 |  |  |  |  |
1414 |  |  |  |  | BAIL_OUT($reason);
1415 |  |  |  |  |
1416 |  |  |  |  | Indicates to the harness that things are going so badly all testing
1417 |  |  |  |  | should terminate. This includes the running of any additional test scripts.
1418 |  |  |  |  |
1419 |  |  |  |  | This is typically used when testing cannot continue such as a critical
1420 |  |  |  |  | module failing to compile or a necessary external utility not being
1421 |  |  |  |  | available such as a database connection failing.
1422 |  |  |  |  |
1423 |  |  |  |  | The test will exit with 255.
1424 |  |  |  |  |
1425 |  |  |  |  | For even better control look at L<Test::Most>.
1426 |  |  |  |  |
1427 |  |  |  |  | =cut
1428 |  |  |  |  |
1429 |  |  |  |  | sub BAIL_OUT {
1430 |  |  |  |  | my $reason = shift;
1431 |  |  |  |  | my $tb = Test::More->builder;
1432 |  |  |  |  |
1433 |  |  |  |  | $tb->BAIL_OUT($reason);
1434 |  |  |  |  | }
1435 |  |  |  |  |
1436 |  |  |  |  | =back
1437 |  |  |  |  |
1438 |  |  |  |  |
1439 |  |  |  |  | =head2 Discouraged comparison functions
1440 |  |  |  |  |
1441 |  |  |  |  | The use of the following functions is discouraged as they are not
1442 |  |  |  |  | actually testing functions and produce no diagnostics to help figure
1443 |  |  |  |  | out what went wrong. They were written before is_deeply() existed
1444 |  |  |  |  | because I couldn't figure out how to display a useful diff of two
1445 |  |  |  |  | arbitrary data structures.
1446 |  |  |  |  |
1447 |  |  |  |  | These functions are usually used inside an ok().
1448 |  |  |  |  |
1449 |  |  |  |  | ok( eq_array(\@got, \@expected) );
1450 |  |  |  |  |
1451 |  |  |  |  | C<is_deeply()> can do that better and with diagnostics.
1452 |  |  |  |  |
1453 |  |  |  |  | is_deeply( \@got, \@expected );
1454 |  |  |  |  |
1455 |  |  |  |  | They may be deprecated in future versions.
1456 |  |  |  |  |
1457 |  |  |  |  | =over 4
1458 |  |  |  |  |
1459 |  |  |  |  | =item B<eq_array>
1460 |  |  |  |  |
1461 |  |  |  |  | my $is_eq = eq_array(\@got, \@expected);
1462 |  |  |  |  |
1463 |  |  |  |  | Checks if two arrays are equivalent. This is a deep check, so
1464 |  |  |  |  | multi-level structures are handled correctly.
1465 |  |  |  |  |
1466 |  |  |  |  | =cut
1467 |  |  |  |  |
1468 |  |  |  |  | #'#
1469 |  |  |  |  | sub eq_array {
1470 |  |  |  |  | local @Data_Stack = ();
1471 |  |  |  |  | _deep_check(@_);
1472 |  |  |  |  | }
1473 |  |  |  |  |
1474 |  |  |  |  | sub _eq_array {
1475 |  |  |  |  | my( $a1, $a2 ) = @_;
1476 |  |  |  |  |
1477 |  |  |  |  | if( grep _type($_) ne 'ARRAY', $a1, $a2 ) {
1478 |  |  |  |  | warn "eq_array passed a non-array ref";
1479 |  |  |  |  | return 0;
1480 |  |  |  |  | }
1481 |  |  |  |  |
1482 |  |  |  |  | return 1 if $a1 eq $a2;
1483 |  |  |  |  |
1484 |  |  |  |  | my $ok = 1;
1485 |  |  |  |  | my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
1486 |  |  |  |  | for( 0 .. $max ) {
1487 |  |  |  |  | my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
1488 |  |  |  |  | my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
1489 |  |  |  |  |
1490 |  |  |  |  | next if _equal_nonrefs($e1, $e2);
1491 |  |  |  |  |
1492 |  |  |  |  | push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] };
1493 |  |  |  |  | $ok = _deep_check( $e1, $e2 );
1494 |  |  |  |  | pop @Data_Stack if $ok;
1495 |  |  |  |  |
1496 |  |  |  |  | last unless $ok;
1497 |  |  |  |  | }
1498 |  |  |  |  |
1499 |  |  |  |  | return $ok;
1500 |  |  |  |  | }
1501 |  |  |  |  |
1502 |  |  |  |  | sub _equal_nonrefs {
1503 |  |  |  |  | my( $e1, $e2 ) = @_;
1504 |  |  |  |  |
1505 |  |  |  |  | return if ref $e1 or ref $e2;
1506 |  |  |  |  |
1507 |  |  |  |  | if ( defined $e1 ) {
1508 |  |  |  |  | return 1 if defined $e2 and $e1 eq $e2;
1509 |  |  |  |  | }
1510 |  |  |  |  | else {
1511 |  |  |  |  | return 1 if !defined $e2;
1512 |  |  |  |  | }
1513 |  |  |  |  |
1514 |  |  |  |  | return;
1515 |  |  |  |  | }
1516 |  |  |  |  |
1517 |  |  |  |  | sub _deep_check {
1518 |  |  |  |  | my( $e1, $e2 ) = @_;
1519 |  |  |  |  | my $tb = Test::More->builder;
1520 |  |  |  |  |
1521 |  |  |  |  | my $ok = 0;
1522 |  |  |  |  |
1523 |  |  |  |  | # Effectively turn %Refs_Seen into a stack. This avoids picking up
1524 |  |  |  |  | # the same referenced used twice (such as [\$a, \$a]) to be considered
1525 |  |  |  |  | # circular.
1526 |  |  |  |  | local %Refs_Seen = %Refs_Seen;
1527 |  |  |  |  |
1528 |  |  |  |  | {
1529 |  |  |  |  | $tb->_unoverload_str( \$e1, \$e2 );
1530 |  |  |  |  |
1531 |  |  |  |  | # Either they're both references or both not.
1532 |  |  |  |  | my $same_ref = !( !ref $e1 xor !ref $e2 );
1533 |  |  |  |  | my $not_ref = ( !ref $e1 and !ref $e2 );
1534 |  |  |  |  |
1535 |  |  |  |  | if( defined $e1 xor defined $e2 ) {
1536 |  |  |  |  | $ok = 0;
1537 |  |  |  |  | }
1538 |  |  |  |  | elsif( !defined $e1 and !defined $e2 ) {
1539 |  |  |  |  | # Shortcut if they're both undefined.
1540 |  |  |  |  | $ok = 1;
1541 |  |  |  |  | }
1542 |  |  |  |  | elsif( _dne($e1) xor _dne($e2) ) {
1543 |  |  |  |  | $ok = 0;
1544 |  |  |  |  | }
1545 |  |  |  |  | elsif( $same_ref and( $e1 eq $e2 ) ) {
1546 |  |  |  |  | $ok = 1;
1547 |  |  |  |  | }
1548 |  |  |  |  | elsif($not_ref) {
1549 |  |  |  |  | push @Data_Stack, { type => '', vals => [ $e1, $e2 ] };
1550 |  |  |  |  | $ok = 0;
1551 |  |  |  |  | }
1552 |  |  |  |  | else {
1553 |  |  |  |  | if( $Refs_Seen{$e1} ) {
1554 |  |  |  |  | return $Refs_Seen{$e1} eq $e2;
1555 |  |  |  |  | }
1556 |  |  |  |  | else {
1557 |  |  |  |  | $Refs_Seen{$e1} = "$e2";
1558 |  |  |  |  | }
1559 |  |  |  |  |
1560 |  |  |  |  | my $type = _type($e1);
1561 |  |  |  |  | $type = 'DIFFERENT' unless _type($e2) eq $type;
1562 |  |  |  |  |
1563 |  |  |  |  | if( $type eq 'DIFFERENT' ) {
1564 |  |  |  |  | push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1565 |  |  |  |  | $ok = 0;
1566 |  |  |  |  | }
1567 |  |  |  |  | elsif( $type eq 'ARRAY' ) {
1568 |  |  |  |  | $ok = _eq_array( $e1, $e2 );
1569 |  |  |  |  | }
1570 |  |  |  |  | elsif( $type eq 'HASH' ) {
1571 |  |  |  |  | $ok = _eq_hash( $e1, $e2 );
1572 |  |  |  |  | }
1573 |  |  |  |  | elsif( $type eq 'REF' ) {
1574 |  |  |  |  | push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1575 |  |  |  |  | $ok = _deep_check( $$e1, $$e2 );
1576 |  |  |  |  | pop @Data_Stack if $ok;
1577 |  |  |  |  | }
1578 |  |  |  |  | elsif( $type eq 'SCALAR' ) {
1579 |  |  |  |  | push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] };
1580 |  |  |  |  | $ok = _deep_check( $$e1, $$e2 );
1581 |  |  |  |  | pop @Data_Stack if $ok;
1582 |  |  |  |  | }
1583 |  |  |  |  | elsif($type) {
1584 |  |  |  |  | push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1585 |  |  |  |  | $ok = 0;
1586 |  |  |  |  | }
1587 |  |  |  |  | else {
1588 |  |  |  |  | _whoa( 1, "No type in _deep_check" );
1589 |  |  |  |  | }
1590 |  |  |  |  | }
1591 |  |  |  |  | }
1592 |  |  |  |  |
1593 |  |  |  |  | return $ok;
1594 |  |  |  |  | }
1595 |  |  |  |  |
1596 |  |  |  |  | sub _whoa {
1597 |  |  |  |  | my( $check, $desc ) = @_;
1598 |  |  |  |  | if($check) {
1599 |  |  |  |  | die <<"WHOA";
1600 |  |  |  |  | WHOA! $desc
1601 |  |  |  |  | This should never happen! Please contact the author immediately!
1602 |  |  |  |  | WHOA
1603 |  |  |  |  | }
1604 |  |  |  |  | }
1605 |  |  |  |  |
1606 |  |  |  |  | =item B<eq_hash>
1607 |  |  |  |  |
1608 |  |  |  |  | my $is_eq = eq_hash(\%got, \%expected);
1609 |  |  |  |  |
1610 |  |  |  |  | Determines if the two hashes contain the same keys and values. This
1611 |  |  |  |  | is a deep check.
1612 |  |  |  |  |
1613 |  |  |  |  | =cut
1614 |  |  |  |  |
1615 |  |  |  |  | sub eq_hash {
1616 |  |  |  |  | local @Data_Stack = ();
1617 |  |  |  |  | return _deep_check(@_);
1618 |  |  |  |  | }
1619 |  |  |  |  |
1620 |  |  |  |  | sub _eq_hash {
1621 |  |  |  |  | my( $a1, $a2 ) = @_;
1622 |  |  |  |  |
1623 |  |  |  |  | if( grep _type($_) ne 'HASH', $a1, $a2 ) {
1624 |  |  |  |  | warn "eq_hash passed a non-hash ref";
1625 |  |  |  |  | return 0;
1626 |  |  |  |  | }
1627 |  |  |  |  |
1628 |  |  |  |  | return 1 if $a1 eq $a2;
1629 |  |  |  |  |
1630 |  |  |  |  | my $ok = 1;
1631 |  |  |  |  | my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
1632 |  |  |  |  | foreach my $k ( keys %$bigger ) {
1633 |  |  |  |  | my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
1634 |  |  |  |  | my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
1635 |  |  |  |  |
1636 |  |  |  |  | next if _equal_nonrefs($e1, $e2);
1637 |  |  |  |  |
1638 |  |  |  |  | push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] };
1639 |  |  |  |  | $ok = _deep_check( $e1, $e2 );
1640 |  |  |  |  | pop @Data_Stack if $ok;
1641 |  |  |  |  |
1642 |  |  |  |  | last unless $ok;
1643 |  |  |  |  | }
1644 |  |  |  |  |
1645 |  |  |  |  | return $ok;
1646 |  |  |  |  | }
1647 |  |  |  |  |
1648 |  |  |  |  | =item B<eq_set>
1649 |  |  |  |  |
1650 |  |  |  |  | my $is_eq = eq_set(\@got, \@expected);
1651 |  |  |  |  |
1652 |  |  |  |  | Similar to eq_array(), except the order of the elements is B<not>
1653 |  |  |  |  | important. This is a deep check, but the irrelevancy of order only
1654 |  |  |  |  | applies to the top level.
1655 |  |  |  |  |
1656 |  |  |  |  | ok( eq_set(\@got, \@expected) );
1657 |  |  |  |  |
1658 |  |  |  |  | Is better written:
1659 |  |  |  |  |
1660 |  |  |  |  | is_deeply( [sort @got], [sort @expected] );
1661 |  |  |  |  |
1662 |  |  |  |  | B<NOTE> By historical accident, this is not a true set comparison.
1663 |  |  |  |  | While the order of elements does not matter, duplicate elements do.
1664 |  |  |  |  |
1665 |  |  |  |  | B<NOTE> eq_set() does not know how to deal with references at the top
1666 |  |  |  |  | level. The following is an example of a comparison which might not work:
1667 |  |  |  |  |
1668 |  |  |  |  | eq_set([\1, \2], [\2, \1]);
1669 |  |  |  |  |
1670 |  |  |  |  | L<Test::Deep> contains much better set comparison functions.
1671 |  |  |  |  |
1672 |  |  |  |  | =cut
1673 |  |  |  |  |
1674 |  |  |  |  | sub eq_set {
1675 |  |  |  |  | my( $a1, $a2 ) = @_;
1676 |  |  |  |  | return 0 unless @$a1 == @$a2;
1677 |  |  |  |  |
1678 | 2 | 170µs | 2 | 40µs | # spent 28µs (16+12) within Test::More::BEGIN@1678 which was called: # once (16µs+12µs) by main::BEGIN@6 at line 1678 no warnings 'uninitialized'; # spent 28µs making 1 call to Test::More::BEGIN@1678 # spent 12µs making 1 call to warnings::unimport
1679 |  |  |  |  |
1680 |  |  |  |  | # It really doesn't matter how we sort them, as long as both arrays are
1681 |  |  |  |  | # sorted with the same algorithm.
1682 |  |  |  |  | #
1683 |  |  |  |  | # Ensure that references are not accidentally treated the same as a
1684 |  |  |  |  | # string containing the reference.
1685 |  |  |  |  | #
1686 |  |  |  |  | # Have to inline the sort routine due to a threading/sort bug.
1687 |  |  |  |  | # See [rt.cpan.org 6782]
1688 |  |  |  |  | #
1689 |  |  |  |  | # I don't know how references would be sorted so we just don't sort
1690 |  |  |  |  | # them. This means eq_set doesn't really work with refs.
1691 |  |  |  |  | return eq_array(
1692 |  |  |  |  | [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ],
1693 |  |  |  |  | [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ],
1694 |  |  |  |  | );
1695 |  |  |  |  | }
1696 |  |  |  |  |
1697 |  |  |  |  | =back
1698 |  |  |  |  |
1699 |  |  |  |  |
1700 |  |  |  |  | =head2 Extending and Embedding Test::More
1701 |  |  |  |  |
1702 |  |  |  |  | Sometimes the Test::More interface isn't quite enough. Fortunately,
1703 |  |  |  |  | Test::More is built on top of Test::Builder which provides a single,
1704 |  |  |  |  | unified backend for any test library to use. This means two test
1705 |  |  |  |  | libraries which both use Test::Builder B<can be used together in the
1706 |  |  |  |  | same program>.
1707 |  |  |  |  |
1708 |  |  |  |  | If you simply want to do a little tweaking of how the tests behave,
1709 |  |  |  |  | you can access the underlying Test::Builder object like so:
1710 |  |  |  |  |
1711 |  |  |  |  | =over 4
1712 |  |  |  |  |
1713 |  |  |  |  | =item B<builder>
1714 |  |  |  |  |
1715 |  |  |  |  | my $test_builder = Test::More->builder;
1716 |  |  |  |  |
1717 |  |  |  |  | Returns the Test::Builder object underlying Test::More for you to play
1718 |  |  |  |  | with.
1719 |  |  |  |  |
1720 |  |  |  |  |
1721 |  |  |  |  | =back
1722 |  |  |  |  |
1723 |  |  |  |  |
1724 |  |  |  |  | =head1 EXIT CODES
1725 |  |  |  |  |
1726 |  |  |  |  | If all your tests passed, Test::Builder will exit with zero (which is
1727 |  |  |  |  | normal). If anything failed it will exit with how many failed. If
1728 |  |  |  |  | you run less (or more) tests than you planned, the missing (or extras)
1729 |  |  |  |  | will be considered failures. If no tests were ever run Test::Builder
1730 |  |  |  |  | will throw a warning and exit with 255. If the test died, even after
1731 |  |  |  |  | having successfully completed all its tests, it will still be
1732 |  |  |  |  | considered a failure and will exit with 255.
1733 |  |  |  |  |
1734 |  |  |  |  | So the exit codes are...
1735 |  |  |  |  |
1736 |  |  |  |  | 0 all tests successful
1737 |  |  |  |  | 255 test died or all passed but wrong # of tests run
1738 |  |  |  |  | any other number how many failed (including missing or extras)
1739 |  |  |  |  |
1740 |  |  |  |  | If you fail more than 254 tests, it will be reported as 254.
1741 |  |  |  |  |
1742 |  |  |  |  | B<NOTE> This behavior may go away in future versions.
1743 |  |  |  |  |
1744 |  |  |  |  |
1745 |  |  |  |  | =head1 COMPATIBILITY
1746 |  |  |  |  |
1747 |  |  |  |  | Test::More works with Perls as old as 5.8.1.
1748 |  |  |  |  |
1749 |  |  |  |  | Thread support is not very reliable before 5.10.1, but that's
1750 |  |  |  |  | because threads are not very reliable before 5.10.1.
1751 |  |  |  |  |
1752 |  |  |  |  | Although Test::More has been a core module in versions of Perl since 5.6.2, Test::More has evolved since then, and not all of the features you're used to will be present in the shipped version of Test::More. If you are writing a module, don't forget to indicate in your package metadata the minimum version of Test::More that you require. For instance, if you want to use C<done_testing()> but want your test script to run on Perl 5.10.0, you will need to explicitly require Test::More > 0.88.
1753 |  |  |  |  |
1754 |  |  |  |  | Key feature milestones include:
1755 |  |  |  |  |
1756 |  |  |  |  | =over 4
1757 |  |  |  |  |
1758 |  |  |  |  | =item subtests
1759 |  |  |  |  |
1760 |  |  |  |  | Subtests were released in Test::More 0.94, which came with Perl 5.12.0. Subtests did not implicitly call C<done_testing()> until 0.96; the first Perl with that fix was Perl 5.14.0 with 0.98.
1761 |  |  |  |  |
1762 |  |  |  |  | =item C<done_testing()>
1763 |  |  |  |  |
1764 |  |  |  |  | This was released in Test::More 0.88 and first shipped with Perl in 5.10.1 as part of Test::More 0.92.
1765 |  |  |  |  |
1766 |  |  |  |  | =item C<cmp_ok()>
1767 |  |  |  |  |
1768 |  |  |  |  | Although C<cmp_ok()> was introduced in 0.40, 0.86 fixed an important bug to make it safe for overloaded objects; the fixed first shipped with Perl in 5.10.1 as part of Test::More 0.92.
1769 |  |  |  |  |
1770 |  |  |  |  | =item C<new_ok()> C<note()> and C<explain()>
1771 |  |  |  |  |
1772 |  |  |  |  | These were was released in Test::More 0.82, and first shipped with Perl in 5.10.1 as part of Test::More 0.92.
1773 |  |  |  |  |
1774 |  |  |  |  | =back
1775 |  |  |  |  |
1776 |  |  |  |  | There is a full version history in the Changes file, and the Test::More versions included as core can be found using L<Module::CoreList>:
1777 |  |  |  |  |
1778 |  |  |  |  | $ corelist -a Test::More
1779 |  |  |  |  |
1780 |  |  |  |  |
1781 |  |  |  |  | =head1 CAVEATS and NOTES
1782 |  |  |  |  |
1783 |  |  |  |  | =over 4
1784 |  |  |  |  |
1785 |  |  |  |  | =item utf8 / "Wide character in print"
1786 |  |  |  |  |
1787 |  |  |  |  | If you use utf8 or other non-ASCII characters with Test::More you
1788 |  |  |  |  | might get a "Wide character in print" warning. Using C<binmode
1789 |  |  |  |  | STDOUT, ":utf8"> will not fix it. Test::Builder (which powers
1790 |  |  |  |  | Test::More) duplicates STDOUT and STDERR. So any changes to them,
1791 |  |  |  |  | including changing their output disciplines, will not be seem by
1792 |  |  |  |  | Test::More.
1793 |  |  |  |  |
1794 |  |  |  |  | One work around is to apply encodings to STDOUT and STDERR as early
1795 |  |  |  |  | as possible and before Test::More (or any other Test module) loads.
1796 |  |  |  |  |
1797 |  |  |  |  | use open ':std', ':encoding(utf8)';
1798 |  |  |  |  | use Test::More;
1799 |  |  |  |  |
1800 |  |  |  |  | A more direct work around is to change the filehandles used by
1801 |  |  |  |  | Test::Builder.
1802 |  |  |  |  |
1803 |  |  |  |  | my $builder = Test::More->builder;
1804 |  |  |  |  | binmode $builder->output, ":encoding(utf8)";
1805 |  |  |  |  | binmode $builder->failure_output, ":encoding(utf8)";
1806 |  |  |  |  | binmode $builder->todo_output, ":encoding(utf8)";
1807 |  |  |  |  |
1808 |  |  |  |  |
1809 |  |  |  |  | =item Overloaded objects
1810 |  |  |  |  |
1811 |  |  |  |  | String overloaded objects are compared B<as strings> (or in cmp_ok()'s
1812 |  |  |  |  | case, strings or numbers as appropriate to the comparison op). This
1813 |  |  |  |  | prevents Test::More from piercing an object's interface allowing
1814 |  |  |  |  | better blackbox testing. So if a function starts returning overloaded
1815 |  |  |  |  | objects instead of bare strings your tests won't notice the
1816 |  |  |  |  | difference. This is good.
1817 |  |  |  |  |
1818 |  |  |  |  | However, it does mean that functions like is_deeply() cannot be used to
1819 |  |  |  |  | test the internals of string overloaded objects. In this case I would
1820 |  |  |  |  | suggest L<Test::Deep> which contains more flexible testing functions for
1821 |  |  |  |  | complex data structures.
1822 |  |  |  |  |
1823 |  |  |  |  |
1824 |  |  |  |  | =item Threads
1825 |  |  |  |  |
1826 |  |  |  |  | Test::More will only be aware of threads if "use threads" has been done
1827 |  |  |  |  | I<before> Test::More is loaded. This is ok:
1828 |  |  |  |  |
1829 |  |  |  |  | use threads;
1830 |  |  |  |  | use Test::More;
1831 |  |  |  |  |
1832 |  |  |  |  | This may cause problems:
1833 |  |  |  |  |
1834 |  |  |  |  | use Test::More
1835 |  |  |  |  | use threads;
1836 |  |  |  |  |
1837 |  |  |  |  | 5.8.1 and above are supported. Anything below that has too many bugs.
1838 |  |  |  |  |
1839 |  |  |  |  | =back
1840 |  |  |  |  |
1841 |  |  |  |  |
1842 |  |  |  |  | =head1 HISTORY
1843 |  |  |  |  |
1844 |  |  |  |  | This is a case of convergent evolution with Joshua Pritikin's Test
1845 |  |  |  |  | module. I was largely unaware of its existence when I'd first
1846 |  |  |  |  | written my own ok() routines. This module exists because I can't
1847 |  |  |  |  | figure out how to easily wedge test names into Test's interface (along
1848 |  |  |  |  | with a few other problems).
1849 |  |  |  |  |
1850 |  |  |  |  | The goal here is to have a testing utility that's simple to learn,
1851 |  |  |  |  | quick to use and difficult to trip yourself up with while still
1852 |  |  |  |  | providing more flexibility than the existing Test.pm. As such, the
1853 |  |  |  |  | names of the most common routines are kept tiny, special cases and
1854 |  |  |  |  | magic side-effects are kept to a minimum. WYSIWYG.
1855 |  |  |  |  |
1856 |  |  |  |  |
1857 |  |  |  |  | =head1 SEE ALSO
1858 |  |  |  |  |
1859 |  |  |  |  | L<Test::Simple> if all this confuses you and you just want to write
1860 |  |  |  |  | some tests. You can upgrade to Test::More later (it's forward
1861 |  |  |  |  | compatible).
1862 |  |  |  |  |
1863 |  |  |  |  | L<Test::Harness> is the test runner and output interpreter for Perl.
1864 |  |  |  |  | It's the thing that powers C<make test> and where the C<prove> utility
1865 |  |  |  |  | comes from.
1866 |  |  |  |  |
1867 |  |  |  |  | L<Test::Legacy> tests written with Test.pm, the original testing
1868 |  |  |  |  | module, do not play well with other testing libraries. Test::Legacy
1869 |  |  |  |  | emulates the Test.pm interface and does play well with others.
1870 |  |  |  |  |
1871 |  |  |  |  | L<Test::Differences> for more ways to test complex data structures.
1872 |  |  |  |  | And it plays well with Test::More.
1873 |  |  |  |  |
1874 |  |  |  |  | L<Test::Class> is like xUnit but more perlish.
1875 |  |  |  |  |
1876 |  |  |  |  | L<Test::Deep> gives you more powerful complex data structure testing.
1877 |  |  |  |  |
1878 |  |  |  |  | L<Test::Inline> shows the idea of embedded testing.
1879 |  |  |  |  |
1880 |  |  |  |  | L<Bundle::Test> installs a whole bunch of useful test modules.
1881 |  |  |  |  |
1882 |  |  |  |  |
1883 |  |  |  |  | =head1 AUTHORS
1884 |  |  |  |  |
1885 |  |  |  |  | Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
1886 |  |  |  |  | from Joshua Pritikin's Test module and lots of help from Barrie
1887 |  |  |  |  | Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and
1888 |  |  |  |  | the perl-qa gang.
1889 |  |  |  |  |
1890 |  |  |  |  |
1891 |  |  |  |  | =head1 BUGS
1892 |  |  |  |  |
1893 |  |  |  |  | See F<http://rt.cpan.org> to report and view bugs.
1894 |  |  |  |  |
1895 |  |  |  |  |
1896 |  |  |  |  | =head1 SOURCE
1897 |  |  |  |  |
1898 |  |  |  |  | The source code repository for Test::More can be found at
1899 |  |  |  |  | F<http://github.com/schwern/test-more/>.
1900 |  |  |  |  |
1901 |  |  |  |  |
1902 |  |  |  |  | =head1 COPYRIGHT
1903 |  |  |  |  |
1904 |  |  |  |  | Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1905 |  |  |  |  |
1906 |  |  |  |  | This program is free software; you can redistribute it and/or
1907 |  |  |  |  | modify it under the same terms as Perl itself.
1908 |  |  |  |  |
1909 |  |  |  |  | See F<http://www.perl.com/perl/misc/Artistic.html>
1910 |  |  |  |  |
1911 |  |  |  |  | =cut
1912 |  |  |  |  |
1913 | 1 | 9µs |  |  | 1;