Profile of Test/More.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For t/app_dpath.t
Run on Tue Jun 5 15:25:28 2012
Reported on Tue Jun 5 15:26:02 2012

Filename | /home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/5.14.1/Test/More.pm
Statements | Executed 36 statements in 18.6ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 1.95ms | 44.5ms | Test::More::::BEGIN@23Test::More::BEGIN@23
2 | 2 | 1 | 212µs | 5.01ms | Test::More::::isntTest::More::isnt
1 | 1 | 1 | 111µs | 847µs | Test::More::::diagTest::More::diag
1 | 1 | 1 | 97µs | 152µs | Test::More::::BEGIN@1621Test::More::BEGIN@1621
1 | 1 | 1 | 89µs | 89µs | Test::More::::BEGIN@3Test::More::BEGIN@3
1 | 1 | 1 | 73µs | 548µs | Test::More::::done_testingTest::More::done_testing
1 | 1 | 1 | 66µs | 136µs | Test::More::::BEGIN@1255Test::More::BEGIN@1255
1 | 1 | 1 | 33µs | 62µs | Test::More::::BEGIN@5Test::More::BEGIN@5
1 | 1 | 1 | 32µs | 70µs | Test::More::::BEGIN@1332Test::More::BEGIN@1332
1 | 1 | 1 | 31µs | 48µs | Test::More::::BEGIN@4Test::More::BEGIN@4
1 | 1 | 1 | 20µs | 20µ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__[:592]Test::More::__ANON__[:592]
0 | 0 | 0 | 0s | 0s | Test::More::::__ANON__[:668]Test::More::__ANON__[:668]
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::::_evalTest::More::_eval
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::::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::::isTest::More::is
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::::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::::planTest::More::plan
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
0 | 0 | 0 | 0s | 0s | Test::More::::use_okTest::More::use_ok

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