xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Simple/lib/Test/More.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1b39c5158Smillertpackage Test::More;
2b39c5158Smillert
3b39c5158Smillertuse 5.006;
4b39c5158Smillertuse strict;
5b39c5158Smillertuse warnings;
6b39c5158Smillert
7b39c5158Smillert#---- perlcritic exemptions. ----#
8b39c5158Smillert
9b39c5158Smillert# We use a lot of subroutine prototypes
10b39c5158Smillert## no critic (Subroutines::ProhibitSubroutinePrototypes)
11b39c5158Smillert
12b8851fccSafresh1# Can't use Carp because it might cause C<use_ok()> to accidentally succeed
13b39c5158Smillert# even though the module being used forgot to use Carp.  Yes, this
14b39c5158Smillert# actually happened.
15b39c5158Smillertsub _carp {
16b39c5158Smillert    my( $file, $line ) = ( caller(1) )[ 1, 2 ];
17b39c5158Smillert    return warn @_, " at $file line $line\n";
18b39c5158Smillert}
19b39c5158Smillert
20*3d61058aSafresh1our $VERSION = '1.302199';
21b39c5158Smillert
229f11ffb7Safresh1use Test::Builder::Module;
23b39c5158Smillertour @ISA    = qw(Test::Builder::Module);
24b39c5158Smillertour @EXPORT = qw(ok use_ok require_ok
25b39c5158Smillert  is isnt like unlike is_deeply
26b39c5158Smillert  cmp_ok
27b39c5158Smillert  skip todo todo_skip
28b39c5158Smillert  pass fail
29b39c5158Smillert  eq_array eq_hash eq_set
30b39c5158Smillert  $TODO
31b39c5158Smillert  plan
32b39c5158Smillert  done_testing
33b39c5158Smillert  can_ok isa_ok new_ok
34b39c5158Smillert  diag note explain
35b39c5158Smillert  subtest
36b39c5158Smillert  BAIL_OUT
37b39c5158Smillert);
38b39c5158Smillert
39b39c5158Smillert=head1 NAME
40b39c5158Smillert
41b39c5158SmillertTest::More - yet another framework for writing test scripts
42b39c5158Smillert
43b39c5158Smillert=head1 SYNOPSIS
44b39c5158Smillert
45b39c5158Smillert  use Test::More tests => 23;
46b39c5158Smillert  # or
47b39c5158Smillert  use Test::More skip_all => $reason;
48b39c5158Smillert  # or
49b39c5158Smillert  use Test::More;   # see done_testing()
50b39c5158Smillert
51b39c5158Smillert  require_ok( 'Some::Module' );
52b39c5158Smillert
53b39c5158Smillert  # Various ways to say "ok"
54b39c5158Smillert  ok($got eq $expected, $test_name);
55b39c5158Smillert
56b39c5158Smillert  is  ($got, $expected, $test_name);
57b39c5158Smillert  isnt($got, $expected, $test_name);
58b39c5158Smillert
59b39c5158Smillert  # Rather than print STDERR "# here's what went wrong\n"
60b39c5158Smillert  diag("here's what went wrong");
61b39c5158Smillert
62b39c5158Smillert  like  ($got, qr/expected/, $test_name);
63b39c5158Smillert  unlike($got, qr/expected/, $test_name);
64b39c5158Smillert
65b39c5158Smillert  cmp_ok($got, '==', $expected, $test_name);
66b39c5158Smillert
67b39c5158Smillert  is_deeply($got_complex_structure, $expected_complex_structure, $test_name);
68b39c5158Smillert
69b39c5158Smillert  SKIP: {
70b39c5158Smillert      skip $why, $how_many unless $have_some_feature;
71b39c5158Smillert
72b39c5158Smillert      ok( foo(),       $test_name );
73b39c5158Smillert      is( foo(42), 23, $test_name );
74b39c5158Smillert  };
75b39c5158Smillert
76b39c5158Smillert  TODO: {
77b39c5158Smillert      local $TODO = $why;
78b39c5158Smillert
79b39c5158Smillert      ok( foo(),       $test_name );
80b39c5158Smillert      is( foo(42), 23, $test_name );
81b39c5158Smillert  };
82b39c5158Smillert
83b39c5158Smillert  can_ok($module, @methods);
84b39c5158Smillert  isa_ok($object, $class);
85b39c5158Smillert
86b39c5158Smillert  pass($test_name);
87b39c5158Smillert  fail($test_name);
88b39c5158Smillert
89b39c5158Smillert  BAIL_OUT($why);
90b39c5158Smillert
91b39c5158Smillert  # UNIMPLEMENTED!!!
92b39c5158Smillert  my @status = Test::More::status;
93b39c5158Smillert
94b39c5158Smillert
95b39c5158Smillert=head1 DESCRIPTION
96b39c5158Smillert
97b39c5158SmillertB<STOP!> If you're just getting started writing tests, have a look at
98b46d8ef2Safresh1L<Test2::Suite> first.
99b46d8ef2Safresh1
100b46d8ef2Safresh1This is a drop in replacement for Test::Simple which you can switch to once you
101b46d8ef2Safresh1get the hang of basic testing.
102b39c5158Smillert
103b39c5158SmillertThe purpose of this module is to provide a wide range of testing
104b39c5158Smillertutilities.  Various ways to say "ok" with better diagnostics,
105b39c5158Smillertfacilities to skip tests, test future features and compare complicated
106b39c5158Smillertdata structures.  While you can do almost anything with a simple
107b39c5158SmillertC<ok()> function, it doesn't provide good diagnostic output.
108b39c5158Smillert
109b39c5158Smillert
110b39c5158Smillert=head2 I love it when a plan comes together
111b39c5158Smillert
112b39c5158SmillertBefore anything else, you need a testing plan.  This basically declares
113b39c5158Smillerthow many tests your script is going to run to protect against premature
114b39c5158Smillertfailure.
115b39c5158Smillert
116b39c5158SmillertThe preferred way to do this is to declare a plan when you C<use Test::More>.
117b39c5158Smillert
118b39c5158Smillert  use Test::More tests => 23;
119b39c5158Smillert
120b39c5158SmillertThere are cases when you will not know beforehand how many tests your
121b39c5158Smillertscript is going to run.  In this case, you can declare your tests at
122b39c5158Smillertthe end.
123b39c5158Smillert
124b39c5158Smillert  use Test::More;
125b39c5158Smillert
126b39c5158Smillert  ... run your tests ...
127b39c5158Smillert
128b39c5158Smillert  done_testing( $number_of_tests_run );
129b39c5158Smillert
1309f11ffb7Safresh1B<NOTE> C<done_testing()> should never be called in an C<END { ... }> block.
1319f11ffb7Safresh1
132b39c5158SmillertSometimes you really don't know how many tests were run, or it's too
133b39c5158Smillertdifficult to calculate.  In which case you can leave off
134b39c5158Smillert$number_of_tests_run.
135b39c5158Smillert
136b39c5158SmillertIn some cases, you'll want to completely skip an entire testing script.
137b39c5158Smillert
138b39c5158Smillert  use Test::More skip_all => $skip_reason;
139b39c5158Smillert
140b39c5158SmillertYour script will declare a skip with the reason why you skipped and
141b39c5158Smillertexit immediately with a zero (success).  See L<Test::Harness> for
142b39c5158Smillertdetails.
143b39c5158Smillert
144b39c5158SmillertIf you want to control what functions Test::More will export, you
145b39c5158Smillerthave to use the 'import' option.  For example, to import everything
146b39c5158Smillertbut 'fail', you'd do:
147b39c5158Smillert
148b39c5158Smillert  use Test::More tests => 23, import => ['!fail'];
149b39c5158Smillert
150b8851fccSafresh1Alternatively, you can use the C<plan()> function.  Useful for when you
151b39c5158Smillerthave to calculate the number of tests.
152b39c5158Smillert
153b39c5158Smillert  use Test::More;
154b39c5158Smillert  plan tests => keys %Stuff * 3;
155b39c5158Smillert
156b39c5158Smillertor for deciding between running the tests at all:
157b39c5158Smillert
158b39c5158Smillert  use Test::More;
159b39c5158Smillert  if( $^O eq 'MacOS' ) {
160b39c5158Smillert      plan skip_all => 'Test irrelevant on MacOS';
161b39c5158Smillert  }
162b39c5158Smillert  else {
163b39c5158Smillert      plan tests => 42;
164b39c5158Smillert  }
165b39c5158Smillert
166b39c5158Smillert=cut
167b39c5158Smillert
168b39c5158Smillertsub plan {
169b39c5158Smillert    my $tb = Test::More->builder;
170b39c5158Smillert
171b39c5158Smillert    return $tb->plan(@_);
172b39c5158Smillert}
173b39c5158Smillert
174b39c5158Smillert# This implements "use Test::More 'no_diag'" but the behavior is
175b39c5158Smillert# deprecated.
176b39c5158Smillertsub import_extra {
177b39c5158Smillert    my $class = shift;
178b39c5158Smillert    my $list  = shift;
179b39c5158Smillert
180b39c5158Smillert    my @other = ();
181b39c5158Smillert    my $idx   = 0;
1829f11ffb7Safresh1    my $import;
183b39c5158Smillert    while( $idx <= $#{$list} ) {
184b39c5158Smillert        my $item = $list->[$idx];
185b39c5158Smillert
186b39c5158Smillert        if( defined $item and $item eq 'no_diag' ) {
187b39c5158Smillert            $class->builder->no_diag(1);
188b39c5158Smillert        }
1899f11ffb7Safresh1        elsif( defined $item and $item eq 'import' ) {
1909f11ffb7Safresh1            if ($import) {
1919f11ffb7Safresh1                push @$import, @{$list->[ ++$idx ]};
1929f11ffb7Safresh1            }
1939f11ffb7Safresh1            else {
1949f11ffb7Safresh1                $import = $list->[ ++$idx ];
1959f11ffb7Safresh1                push @other, $item, $import;
1969f11ffb7Safresh1            }
1979f11ffb7Safresh1        }
198b39c5158Smillert        else {
199b39c5158Smillert            push @other, $item;
200b39c5158Smillert        }
201b39c5158Smillert
202b39c5158Smillert        $idx++;
203b39c5158Smillert    }
204b39c5158Smillert
205b39c5158Smillert    @$list = @other;
206b39c5158Smillert
2079f11ffb7Safresh1    if ($class eq __PACKAGE__ && (!$import || grep $_ eq '$TODO', @$import)) {
2089f11ffb7Safresh1        my $to = $class->builder->exported_to;
2099f11ffb7Safresh1        no strict 'refs';
2109f11ffb7Safresh1        *{"$to\::TODO"} = \our $TODO;
2119f11ffb7Safresh1        if ($import) {
2129f11ffb7Safresh1            @$import = grep $_ ne '$TODO', @$import;
2139f11ffb7Safresh1        }
2149f11ffb7Safresh1        else {
2159f11ffb7Safresh1            push @$list, import => [grep $_ ne '$TODO', @EXPORT];
2169f11ffb7Safresh1        }
2179f11ffb7Safresh1    }
2189f11ffb7Safresh1
219b39c5158Smillert    return;
220b39c5158Smillert}
221b39c5158Smillert
222b39c5158Smillert=over 4
223b39c5158Smillert
224b39c5158Smillert=item B<done_testing>
225b39c5158Smillert
226b39c5158Smillert    done_testing();
227b39c5158Smillert    done_testing($number_of_tests);
228b39c5158Smillert
229b39c5158SmillertIf you don't know how many tests you're going to run, you can issue
230b39c5158Smillertthe plan when you're done running tests.
231b39c5158Smillert
232b8851fccSafresh1$number_of_tests is the same as C<plan()>, it's the number of tests you
233b39c5158Smillertexpected to run.  You can omit this, in which case the number of tests
234b39c5158Smillertyou ran doesn't matter, just the fact that your tests ran to
235b39c5158Smillertconclusion.
236b39c5158Smillert
237b39c5158SmillertThis is safer than and replaces the "no_plan" plan.
238b39c5158Smillert
2399f11ffb7Safresh1B<Note:> You must never put C<done_testing()> inside an C<END { ... }> block.
2409f11ffb7Safresh1The plan is there to ensure your test does not exit before testing has
2419f11ffb7Safresh1completed. If you use an END block you completely bypass this protection.
2429f11ffb7Safresh1
243b39c5158Smillert=back
244b39c5158Smillert
245b39c5158Smillert=cut
246b39c5158Smillert
247b39c5158Smillertsub done_testing {
248b39c5158Smillert    my $tb = Test::More->builder;
249b39c5158Smillert    $tb->done_testing(@_);
250b39c5158Smillert}
251b39c5158Smillert
252b39c5158Smillert=head2 Test names
253b39c5158Smillert
254b39c5158SmillertBy convention, each test is assigned a number in order.  This is
255b39c5158Smillertlargely done automatically for you.  However, it's often very useful to
256b39c5158Smillertassign a name to each test.  Which would you rather see:
257b39c5158Smillert
258b39c5158Smillert  ok 4
259b39c5158Smillert  not ok 5
260b39c5158Smillert  ok 6
261b39c5158Smillert
262b39c5158Smillertor
263b39c5158Smillert
264b39c5158Smillert  ok 4 - basic multi-variable
265b39c5158Smillert  not ok 5 - simple exponential
266b39c5158Smillert  ok 6 - force == mass * acceleration
267b39c5158Smillert
268b39c5158SmillertThe later gives you some idea of what failed.  It also makes it easier
269b39c5158Smillertto find the test in your script, simply search for "simple
270b39c5158Smillertexponential".
271b39c5158Smillert
272b39c5158SmillertAll test functions take a name argument.  It's optional, but highly
273b39c5158Smillertsuggested that you use it.
274b39c5158Smillert
275b39c5158Smillert=head2 I'm ok, you're not ok.
276b39c5158Smillert
277b39c5158SmillertThe basic purpose of this module is to print out either "ok #" or "not
278b39c5158Smillertok #" depending on if a given test succeeded or failed.  Everything
279b39c5158Smillertelse is just gravy.
280b39c5158Smillert
281b39c5158SmillertAll of the following print "ok" or "not ok" depending on if the test
282b39c5158Smillertsucceeded or failed.  They all also return true or false,
283b39c5158Smillertrespectively.
284b39c5158Smillert
285b39c5158Smillert=over 4
286b39c5158Smillert
287b39c5158Smillert=item B<ok>
288b39c5158Smillert
289b39c5158Smillert  ok($got eq $expected, $test_name);
290b39c5158Smillert
291b39c5158SmillertThis simply evaluates any expression (C<$got eq $expected> is just a
292b39c5158Smillertsimple example) and uses that to determine if the test succeeded or
293b39c5158Smillertfailed.  A true expression passes, a false one fails.  Very simple.
294b39c5158Smillert
295b39c5158SmillertFor example:
296b39c5158Smillert
297b39c5158Smillert    ok( $exp{9} == 81,                   'simple exponential' );
298b39c5158Smillert    ok( Film->can('db_Main'),            'set_db()' );
299b39c5158Smillert    ok( $p->tests == 4,                  'saw tests' );
300e5157e49Safresh1    ok( !grep(!defined $_, @items),      'all items defined' );
301b39c5158Smillert
302b39c5158Smillert(Mnemonic:  "This is ok.")
303b39c5158Smillert
304b39c5158Smillert$test_name is a very short description of the test that will be printed
305b39c5158Smillertout.  It makes it very easy to find a test in your script when it fails
306b39c5158Smillertand gives others an idea of your intentions.  $test_name is optional,
307b39c5158Smillertbut we B<very> strongly encourage its use.
308b39c5158Smillert
309b8851fccSafresh1Should an C<ok()> fail, it will produce some diagnostics:
310b39c5158Smillert
311b39c5158Smillert    not ok 18 - sufficient mucus
312b39c5158Smillert    #   Failed test 'sufficient mucus'
313b39c5158Smillert    #   in foo.t at line 42.
314b39c5158Smillert
315b8851fccSafresh1This is the same as L<Test::Simple>'s C<ok()> routine.
316b39c5158Smillert
317b39c5158Smillert=cut
318b39c5158Smillert
319b39c5158Smillertsub ok ($;$) {
320b39c5158Smillert    my( $test, $name ) = @_;
321b39c5158Smillert    my $tb = Test::More->builder;
322b39c5158Smillert
323b39c5158Smillert    return $tb->ok( $test, $name );
324b39c5158Smillert}
325b39c5158Smillert
326b39c5158Smillert=item B<is>
327b39c5158Smillert
328b39c5158Smillert=item B<isnt>
329b39c5158Smillert
330b39c5158Smillert  is  ( $got, $expected, $test_name );
331b39c5158Smillert  isnt( $got, $expected, $test_name );
332b39c5158Smillert
333b8851fccSafresh1Similar to C<ok()>, C<is()> and C<isnt()> compare their two arguments
334b39c5158Smillertwith C<eq> and C<ne> respectively and use the result of that to
335b39c5158Smillertdetermine if the test succeeded or failed.  So these:
336b39c5158Smillert
337b39c5158Smillert    # Is the ultimate answer 42?
338b39c5158Smillert    is( ultimate_answer(), 42,          "Meaning of Life" );
339b39c5158Smillert
340b39c5158Smillert    # $foo isn't empty
341b39c5158Smillert    isnt( $foo, '',     "Got some foo" );
342b39c5158Smillert
343b39c5158Smillertare similar to these:
344b39c5158Smillert
345b39c5158Smillert    ok( ultimate_answer() eq 42,        "Meaning of Life" );
346b39c5158Smillert    ok( $foo ne '',     "Got some foo" );
347b39c5158Smillert
3486eddea87SjasperC<undef> will only ever match C<undef>.  So you can test a value
349e5157e49Safresh1against C<undef> like this:
3506eddea87Sjasper
3516eddea87Sjasper    is($not_defined, undef, "undefined as expected");
3526eddea87Sjasper
353b39c5158Smillert(Mnemonic:  "This is that."  "This isn't that.")
354b39c5158Smillert
355b8851fccSafresh1So why use these?  They produce better diagnostics on failure.  C<ok()>
356b8851fccSafresh1cannot know what you are testing for (beyond the name), but C<is()> and
357b8851fccSafresh1C<isnt()> know what the test was and why it failed.  For example this
358b39c5158Smillerttest:
359b39c5158Smillert
360b39c5158Smillert    my $foo = 'waffle';  my $bar = 'yarblokos';
361b39c5158Smillert    is( $foo, $bar,   'Is foo the same as bar?' );
362b39c5158Smillert
363b39c5158SmillertWill produce something like this:
364b39c5158Smillert
365b39c5158Smillert    not ok 17 - Is foo the same as bar?
366b39c5158Smillert    #   Failed test 'Is foo the same as bar?'
367b39c5158Smillert    #   in foo.t at line 139.
368b39c5158Smillert    #          got: 'waffle'
369b39c5158Smillert    #     expected: 'yarblokos'
370b39c5158Smillert
371b39c5158SmillertSo you can figure out what went wrong without rerunning the test.
372b39c5158Smillert
373b8851fccSafresh1You are encouraged to use C<is()> and C<isnt()> over C<ok()> where possible,
374b39c5158Smillerthowever do not be tempted to use them to find out if something is
375b39c5158Smillerttrue or false!
376b39c5158Smillert
377b39c5158Smillert  # XXX BAD!
378b39c5158Smillert  is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' );
379b39c5158Smillert
380b39c5158SmillertThis does not check if C<exists $brooklyn{tree}> is true, it checks if
381b39c5158Smillertit returns 1.  Very different.  Similar caveats exist for false and 0.
382b8851fccSafresh1In these cases, use C<ok()>.
383b39c5158Smillert
384b39c5158Smillert  ok( exists $brooklyn{tree},    'A tree grows in Brooklyn' );
385b39c5158Smillert
386b8851fccSafresh1A simple call to C<isnt()> usually does not provide a strong test but there
387b39c5158Smillertare cases when you cannot say much more about a value than that it is
388b39c5158Smillertdifferent from some other value:
389b39c5158Smillert
390b39c5158Smillert  new_ok $obj, "Foo";
391b39c5158Smillert
392b39c5158Smillert  my $clone = $obj->clone;
393b39c5158Smillert  isa_ok $obj, "Foo", "Foo->clone";
394b39c5158Smillert
395b39c5158Smillert  isnt $obj, $clone, "clone() produces a different object";
396b39c5158Smillert
397e0680481Safresh1Historically we supported an C<isn't()> function as an alias of
398e0680481Safresh1C<isnt()>, however in Perl 5.37.9 support for the use of aprostrophe as
399e0680481Safresh1a package separator was deprecated and by Perl 5.42.0 support for it
400e0680481Safresh1will have been removed completely. Accordingly use of C<isn't()> is also
401e0680481Safresh1deprecated, and will produce warnings when used unless 'deprecated'
402e0680481Safresh1warnings are specifically disabled in the scope where it is used. You
403e0680481Safresh1are strongly advised to migrate to using C<isnt()> instead.
404b39c5158Smillert
405b39c5158Smillert=cut
406b39c5158Smillert
407b39c5158Smillertsub is ($$;$) {
408b39c5158Smillert    my $tb = Test::More->builder;
409b39c5158Smillert
410b39c5158Smillert    return $tb->is_eq(@_);
411b39c5158Smillert}
412b39c5158Smillert
413b39c5158Smillertsub isnt ($$;$) {
414b39c5158Smillert    my $tb = Test::More->builder;
415b39c5158Smillert
416b39c5158Smillert    return $tb->isnt_eq(@_);
417b39c5158Smillert}
418b39c5158Smillert
419e0680481Safresh1# Historically it was possible to use apostrophes as a package
420e0680481Safresh1# separator. make this available as isn't() for perl's that support it.
421e0680481Safresh1# However in 5.37.9 the apostrophe as a package separator was
422e0680481Safresh1# deprecated, so warn users of isn't() that they should use isnt()
423e0680481Safresh1# instead. We assume that if they are calling isn::t() they are doing so
424e0680481Safresh1# via isn't() as we have no way to be sure that they aren't spelling it
425e0680481Safresh1# with a double colon. We only trigger the warning if deprecation
426e0680481Safresh1# warnings are enabled, so the user can silence the warning if they
427e0680481Safresh1# wish.
428e0680481Safresh1sub isn::t {
429e0680481Safresh1    local ($@, $!, $?);
430e0680481Safresh1    if (warnings::enabled("deprecated")) {
431e0680481Safresh1        _carp
432e0680481Safresh1        "Use of apostrophe as package separator was deprecated in Perl 5.37.9,\n",
433e0680481Safresh1        "and will be removed in Perl 5.42.0.  You should change code that uses\n",
434e0680481Safresh1        "Test::More::isn't() to use Test::More::isnt() as a replacement";
435e0680481Safresh1    }
436e0680481Safresh1    goto &isnt;
437e0680481Safresh1}
438b39c5158Smillert
439b39c5158Smillert=item B<like>
440b39c5158Smillert
441b39c5158Smillert  like( $got, qr/expected/, $test_name );
442b39c5158Smillert
443b8851fccSafresh1Similar to C<ok()>, C<like()> matches $got against the regex C<qr/expected/>.
444b39c5158Smillert
445b39c5158SmillertSo this:
446b39c5158Smillert
447b39c5158Smillert    like($got, qr/expected/, 'this is like that');
448b39c5158Smillert
449b39c5158Smillertis similar to:
450b39c5158Smillert
451e5157e49Safresh1    ok( $got =~ m/expected/, 'this is like that');
452b39c5158Smillert
453b39c5158Smillert(Mnemonic "This is like that".)
454b39c5158Smillert
455b39c5158SmillertThe second argument is a regular expression.  It may be given as a
456b39c5158Smillertregex reference (i.e. C<qr//>) or (for better compatibility with older
457b39c5158Smillertperls) as a string that looks like a regex (alternative delimiters are
458b39c5158Smillertcurrently not supported):
459b39c5158Smillert
460b39c5158Smillert    like( $got, '/expected/', 'this is like that' );
461b39c5158Smillert
462b39c5158SmillertRegex options may be placed on the end (C<'/expected/i'>).
463b39c5158Smillert
464b8851fccSafresh1Its advantages over C<ok()> are similar to that of C<is()> and C<isnt()>.  Better
465b39c5158Smillertdiagnostics on failure.
466b39c5158Smillert
467b39c5158Smillert=cut
468b39c5158Smillert
469b39c5158Smillertsub like ($$;$) {
470b39c5158Smillert    my $tb = Test::More->builder;
471b39c5158Smillert
472b39c5158Smillert    return $tb->like(@_);
473b39c5158Smillert}
474b39c5158Smillert
475b39c5158Smillert=item B<unlike>
476b39c5158Smillert
477b39c5158Smillert  unlike( $got, qr/expected/, $test_name );
478b39c5158Smillert
479b8851fccSafresh1Works exactly as C<like()>, only it checks if $got B<does not> match the
480b39c5158Smillertgiven pattern.
481b39c5158Smillert
482b39c5158Smillert=cut
483b39c5158Smillert
484b39c5158Smillertsub unlike ($$;$) {
485b39c5158Smillert    my $tb = Test::More->builder;
486b39c5158Smillert
487b39c5158Smillert    return $tb->unlike(@_);
488b39c5158Smillert}
489b39c5158Smillert
490b39c5158Smillert=item B<cmp_ok>
491b39c5158Smillert
492b39c5158Smillert  cmp_ok( $got, $op, $expected, $test_name );
493b39c5158Smillert
494e5157e49Safresh1Halfway between C<ok()> and C<is()> lies C<cmp_ok()>.  This allows you
495e5157e49Safresh1to compare two arguments using any binary perl operator.  The test
496e5157e49Safresh1passes if the comparison is true and fails otherwise.
497b39c5158Smillert
498b39c5158Smillert    # ok( $got eq $expected );
499b39c5158Smillert    cmp_ok( $got, 'eq', $expected, 'this eq that' );
500b39c5158Smillert
501b39c5158Smillert    # ok( $got == $expected );
502b39c5158Smillert    cmp_ok( $got, '==', $expected, 'this == that' );
503b39c5158Smillert
504b39c5158Smillert    # ok( $got && $expected );
505b39c5158Smillert    cmp_ok( $got, '&&', $expected, 'this && that' );
506b39c5158Smillert    ...etc...
507b39c5158Smillert
508b8851fccSafresh1Its advantage over C<ok()> is when the test fails you'll know what $got
509b39c5158Smillertand $expected were:
510b39c5158Smillert
511b39c5158Smillert    not ok 1
512b39c5158Smillert    #   Failed test in foo.t at line 12.
513b39c5158Smillert    #     '23'
514b39c5158Smillert    #         &&
515b39c5158Smillert    #     undef
516b39c5158Smillert
517b39c5158SmillertIt's also useful in those cases where you are comparing numbers and
518b8851fccSafresh1C<is()>'s use of C<eq> will interfere:
519b39c5158Smillert
520b39c5158Smillert    cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
521b39c5158Smillert
522b39c5158SmillertIt's especially useful when comparing greater-than or smaller-than
523b39c5158Smillertrelation between values:
524b39c5158Smillert
525b39c5158Smillert    cmp_ok( $some_value, '<=', $upper_limit );
526b39c5158Smillert
527b39c5158Smillert
528b39c5158Smillert=cut
529b39c5158Smillert
530b39c5158Smillertsub cmp_ok($$$;$) {
531b39c5158Smillert    my $tb = Test::More->builder;
532b39c5158Smillert
533b39c5158Smillert    return $tb->cmp_ok(@_);
534b39c5158Smillert}
535b39c5158Smillert
536b39c5158Smillert=item B<can_ok>
537b39c5158Smillert
538b39c5158Smillert  can_ok($module, @methods);
539b39c5158Smillert  can_ok($object, @methods);
540b39c5158Smillert
541b39c5158SmillertChecks to make sure the $module or $object can do these @methods
542b39c5158Smillert(works with functions, too).
543b39c5158Smillert
544b39c5158Smillert    can_ok('Foo', qw(this that whatever));
545b39c5158Smillert
546b39c5158Smillertis almost exactly like saying:
547b39c5158Smillert
548b39c5158Smillert    ok( Foo->can('this') &&
549b39c5158Smillert        Foo->can('that') &&
550b39c5158Smillert        Foo->can('whatever')
551b39c5158Smillert      );
552b39c5158Smillert
553b39c5158Smillertonly without all the typing and with a better interface.  Handy for
554b39c5158Smillertquickly testing an interface.
555b39c5158Smillert
556b8851fccSafresh1No matter how many @methods you check, a single C<can_ok()> call counts
557b39c5158Smillertas one test.  If you desire otherwise, use:
558b39c5158Smillert
559b39c5158Smillert    foreach my $meth (@methods) {
560b39c5158Smillert        can_ok('Foo', $meth);
561b39c5158Smillert    }
562b39c5158Smillert
563b39c5158Smillert=cut
564b39c5158Smillert
565b39c5158Smillertsub can_ok ($@) {
566b39c5158Smillert    my( $proto, @methods ) = @_;
567b39c5158Smillert    my $class = ref $proto || $proto;
568b39c5158Smillert    my $tb = Test::More->builder;
569b39c5158Smillert
570b39c5158Smillert    unless($class) {
571b39c5158Smillert        my $ok = $tb->ok( 0, "->can(...)" );
572b39c5158Smillert        $tb->diag('    can_ok() called with empty class or reference');
573b39c5158Smillert        return $ok;
574b39c5158Smillert    }
575b39c5158Smillert
576b39c5158Smillert    unless(@methods) {
577b39c5158Smillert        my $ok = $tb->ok( 0, "$class->can(...)" );
578b39c5158Smillert        $tb->diag('    can_ok() called with no methods');
579b39c5158Smillert        return $ok;
580b39c5158Smillert    }
581b39c5158Smillert
582b39c5158Smillert    my @nok = ();
583b39c5158Smillert    foreach my $method (@methods) {
584b39c5158Smillert        $tb->_try( sub { $proto->can($method) } ) or push @nok, $method;
585b39c5158Smillert    }
586b39c5158Smillert
587b39c5158Smillert    my $name = (@methods == 1) ? "$class->can('$methods[0]')" :
588b39c5158Smillert                                 "$class->can(...)"           ;
589b39c5158Smillert
590b39c5158Smillert    my $ok = $tb->ok( !@nok, $name );
591b39c5158Smillert
592b39c5158Smillert    $tb->diag( map "    $class->can('$_') failed\n", @nok );
593b39c5158Smillert
594b39c5158Smillert    return $ok;
595b39c5158Smillert}
596b39c5158Smillert
597b39c5158Smillert=item B<isa_ok>
598b39c5158Smillert
599b39c5158Smillert  isa_ok($object,   $class, $object_name);
600b39c5158Smillert  isa_ok($subclass, $class, $object_name);
601b39c5158Smillert  isa_ok($ref,      $type,  $ref_name);
602b39c5158Smillert
603b39c5158SmillertChecks to see if the given C<< $object->isa($class) >>.  Also checks to make
604b39c5158Smillertsure the object was defined in the first place.  Handy for this sort
605b39c5158Smillertof thing:
606b39c5158Smillert
607b39c5158Smillert    my $obj = Some::Module->new;
608b39c5158Smillert    isa_ok( $obj, 'Some::Module' );
609b39c5158Smillert
610b39c5158Smillertwhere you'd otherwise have to write
611b39c5158Smillert
612b39c5158Smillert    my $obj = Some::Module->new;
613b39c5158Smillert    ok( defined $obj && $obj->isa('Some::Module') );
614b39c5158Smillert
615b39c5158Smillertto safeguard against your test script blowing up.
616b39c5158Smillert
617b39c5158SmillertYou can also test a class, to make sure that it has the right ancestor:
618b39c5158Smillert
619b39c5158Smillert    isa_ok( 'Vole', 'Rodent' );
620b39c5158Smillert
621b39c5158SmillertIt works on references, too:
622b39c5158Smillert
623b39c5158Smillert    isa_ok( $array_ref, 'ARRAY' );
624b39c5158Smillert
625b39c5158SmillertThe diagnostics of this test normally just refer to 'the object'.  If
626b39c5158Smillertyou'd like them to be more specific, you can supply an $object_name
627b39c5158Smillert(for example 'Test customer').
628b39c5158Smillert
629b39c5158Smillert=cut
630b39c5158Smillert
631b39c5158Smillertsub isa_ok ($$;$) {
632e5157e49Safresh1    my( $thing, $class, $thing_name ) = @_;
633b39c5158Smillert    my $tb = Test::More->builder;
634b39c5158Smillert
635e5157e49Safresh1    my $whatami;
636e5157e49Safresh1    if( !defined $thing ) {
637e5157e49Safresh1        $whatami = 'undef';
638e5157e49Safresh1    }
639e5157e49Safresh1    elsif( ref $thing ) {
640e5157e49Safresh1        $whatami = 'reference';
641b39c5158Smillert
642e5157e49Safresh1        local($@,$!);
643e5157e49Safresh1        require Scalar::Util;
644e5157e49Safresh1        if( Scalar::Util::blessed($thing) ) {
645e5157e49Safresh1            $whatami = 'object';
646e5157e49Safresh1        }
647b39c5158Smillert    }
648b39c5158Smillert    else {
649e5157e49Safresh1        $whatami = 'class';
650e5157e49Safresh1    }
651e5157e49Safresh1
652b39c5158Smillert    # We can't use UNIVERSAL::isa because we want to honor isa() overrides
653e5157e49Safresh1    my( $rslt, $error ) = $tb->_try( sub { $thing->isa($class) } );
654e5157e49Safresh1
655b39c5158Smillert    if($error) {
656e5157e49Safresh1        die <<WHOA unless $error =~ /^Can't (locate|call) method "isa"/;
657b39c5158SmillertWHOA! I tried to call ->isa on your $whatami and got some weird error.
658b39c5158SmillertHere's the error.
659b39c5158Smillert$error
660b39c5158SmillertWHOA
661b39c5158Smillert    }
662e5157e49Safresh1
663e5157e49Safresh1    # Special case for isa_ok( [], "ARRAY" ) and like
664e5157e49Safresh1    if( $whatami eq 'reference' ) {
665e5157e49Safresh1        $rslt = UNIVERSAL::isa($thing, $class);
666b39c5158Smillert    }
667b39c5158Smillert
668e5157e49Safresh1    my($diag, $name);
669e5157e49Safresh1    if( defined $thing_name ) {
670e5157e49Safresh1        $name = "'$thing_name' isa '$class'";
671e5157e49Safresh1        $diag = defined $thing ? "'$thing_name' isn't a '$class'" : "'$thing_name' isn't defined";
672e5157e49Safresh1    }
673e5157e49Safresh1    elsif( $whatami eq 'object' ) {
674e5157e49Safresh1        my $my_class = ref $thing;
675e5157e49Safresh1        $thing_name = qq[An object of class '$my_class'];
676e5157e49Safresh1        $name = "$thing_name isa '$class'";
677e5157e49Safresh1        $diag = "The object of class '$my_class' isn't a '$class'";
678e5157e49Safresh1    }
679e5157e49Safresh1    elsif( $whatami eq 'reference' ) {
680e5157e49Safresh1        my $type = ref $thing;
681e5157e49Safresh1        $thing_name = qq[A reference of type '$type'];
682e5157e49Safresh1        $name = "$thing_name isa '$class'";
683e5157e49Safresh1        $diag = "The reference of type '$type' isn't a '$class'";
684e5157e49Safresh1    }
685e5157e49Safresh1    elsif( $whatami eq 'undef' ) {
686e5157e49Safresh1        $thing_name = 'undef';
687e5157e49Safresh1        $name = "$thing_name isa '$class'";
688e5157e49Safresh1        $diag = "$thing_name isn't defined";
689e5157e49Safresh1    }
690e5157e49Safresh1    elsif( $whatami eq 'class' ) {
691e5157e49Safresh1        $thing_name = qq[The class (or class-like) '$thing'];
692e5157e49Safresh1        $name = "$thing_name isa '$class'";
693e5157e49Safresh1        $diag = "$thing_name isn't a '$class'";
694b39c5158Smillert    }
695b39c5158Smillert    else {
696e5157e49Safresh1        die;
697e5157e49Safresh1    }
698e5157e49Safresh1
699e5157e49Safresh1    my $ok;
700e5157e49Safresh1    if($rslt) {
701b39c5158Smillert        $ok = $tb->ok( 1, $name );
702b39c5158Smillert    }
703e5157e49Safresh1    else {
704e5157e49Safresh1        $ok = $tb->ok( 0, $name );
705e5157e49Safresh1        $tb->diag("    $diag\n");
706e5157e49Safresh1    }
707b39c5158Smillert
708b39c5158Smillert    return $ok;
709b39c5158Smillert}
710b39c5158Smillert
711b39c5158Smillert=item B<new_ok>
712b39c5158Smillert
713b39c5158Smillert  my $obj = new_ok( $class );
714b39c5158Smillert  my $obj = new_ok( $class => \@args );
715b39c5158Smillert  my $obj = new_ok( $class => \@args, $object_name );
716b39c5158Smillert
717b39c5158SmillertA convenience function which combines creating an object and calling
718b8851fccSafresh1C<isa_ok()> on that object.
719b39c5158Smillert
720b39c5158SmillertIt is basically equivalent to:
721b39c5158Smillert
722b39c5158Smillert    my $obj = $class->new(@args);
723b39c5158Smillert    isa_ok $obj, $class, $object_name;
724b39c5158Smillert
725b39c5158SmillertIf @args is not given, an empty list will be used.
726b39c5158Smillert
727b8851fccSafresh1This function only works on C<new()> and it assumes C<new()> will return
728b39c5158Smillertjust a single object which isa C<$class>.
729b39c5158Smillert
730b39c5158Smillert=cut
731b39c5158Smillert
732b39c5158Smillertsub new_ok {
733b39c5158Smillert    my $tb = Test::More->builder;
734b39c5158Smillert    $tb->croak("new_ok() must be given at least a class") unless @_;
735b39c5158Smillert
736b39c5158Smillert    my( $class, $args, $object_name ) = @_;
737b39c5158Smillert
738b39c5158Smillert    $args ||= [];
739b39c5158Smillert
740b39c5158Smillert    my $obj;
741b39c5158Smillert    my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } );
742b39c5158Smillert    if($success) {
743b39c5158Smillert        local $Test::Builder::Level = $Test::Builder::Level + 1;
744b39c5158Smillert        isa_ok $obj, $class, $object_name;
745b39c5158Smillert    }
746b39c5158Smillert    else {
747e5157e49Safresh1        $class = 'undef' if !defined $class;
748e5157e49Safresh1        $tb->ok( 0, "$class->new() died" );
749b39c5158Smillert        $tb->diag("    Error was:  $error");
750b39c5158Smillert    }
751b39c5158Smillert
752b39c5158Smillert    return $obj;
753b39c5158Smillert}
754b39c5158Smillert
755b39c5158Smillert=item B<subtest>
756b39c5158Smillert
7579f11ffb7Safresh1    subtest $name => \&code, @args;
758b39c5158Smillert
759b8851fccSafresh1C<subtest()> runs the &code as its own little test with its own plan and
760b39c5158Smillertits own result.  The main test counts this as a single test using the
761b39c5158Smillertresult of the whole subtest to determine if its ok or not ok.
762b39c5158Smillert
763b39c5158SmillertFor example...
764b39c5158Smillert
765b39c5158Smillert  use Test::More tests => 3;
766b39c5158Smillert
767b39c5158Smillert  pass("First test");
768b39c5158Smillert
769b39c5158Smillert  subtest 'An example subtest' => sub {
770b39c5158Smillert      plan tests => 2;
771b39c5158Smillert
772b39c5158Smillert      pass("This is a subtest");
773b39c5158Smillert      pass("So is this");
774b39c5158Smillert  };
775b39c5158Smillert
776b39c5158Smillert  pass("Third test");
777b39c5158Smillert
778b39c5158SmillertThis would produce.
779b39c5158Smillert
780b39c5158Smillert  1..3
781b39c5158Smillert  ok 1 - First test
782e5157e49Safresh1      # Subtest: An example subtest
783b39c5158Smillert      1..2
784b39c5158Smillert      ok 1 - This is a subtest
785b39c5158Smillert      ok 2 - So is this
786b39c5158Smillert  ok 2 - An example subtest
787b39c5158Smillert  ok 3 - Third test
788b39c5158Smillert
789b8851fccSafresh1A subtest may call C<skip_all>.  No tests will be run, but the subtest is
790b39c5158Smillertconsidered a skip.
791b39c5158Smillert
792b39c5158Smillert  subtest 'skippy' => sub {
793b39c5158Smillert      plan skip_all => 'cuz I said so';
794b39c5158Smillert      pass('this test will never be run');
795b39c5158Smillert  };
796b39c5158Smillert
797b39c5158SmillertReturns true if the subtest passed, false otherwise.
798b39c5158Smillert
79965d9bffcSjasperDue to how subtests work, you may omit a plan if you desire.  This adds an
80065d9bffcSjasperimplicit C<done_testing()> to the end of your subtest.  The following two
80165d9bffcSjaspersubtests are equivalent:
80265d9bffcSjasper
80365d9bffcSjasper  subtest 'subtest with implicit done_testing()', sub {
80465d9bffcSjasper      ok 1, 'subtests with an implicit done testing should work';
80565d9bffcSjasper      ok 1, '... and support more than one test';
80665d9bffcSjasper      ok 1, '... no matter how many tests are run';
80765d9bffcSjasper  };
80865d9bffcSjasper
80965d9bffcSjasper  subtest 'subtest with explicit done_testing()', sub {
81065d9bffcSjasper      ok 1, 'subtests with an explicit done testing should work';
81165d9bffcSjasper      ok 1, '... and support more than one test';
81265d9bffcSjasper      ok 1, '... no matter how many tests are run';
81365d9bffcSjasper      done_testing();
81465d9bffcSjasper  };
81565d9bffcSjasper
8169f11ffb7Safresh1Extra arguments given to C<subtest> are passed to the callback. For example:
8179f11ffb7Safresh1
8189f11ffb7Safresh1    sub my_subtest {
8199f11ffb7Safresh1        my $range = shift;
8209f11ffb7Safresh1        ...
8219f11ffb7Safresh1    }
8229f11ffb7Safresh1
8239f11ffb7Safresh1    for my $range (1, 10, 100, 1000) {
8249f11ffb7Safresh1        subtest "testing range $range", \&my_subtest, $range;
8259f11ffb7Safresh1    }
8269f11ffb7Safresh1
827b39c5158Smillert=cut
828b39c5158Smillert
8296eddea87Sjaspersub subtest {
830b39c5158Smillert    my $tb = Test::More->builder;
831b39c5158Smillert    return $tb->subtest(@_);
832b39c5158Smillert}
833b39c5158Smillert
834b39c5158Smillert=item B<pass>
835b39c5158Smillert
836b39c5158Smillert=item B<fail>
837b39c5158Smillert
838b39c5158Smillert  pass($test_name);
839b39c5158Smillert  fail($test_name);
840b39c5158Smillert
841b39c5158SmillertSometimes you just want to say that the tests have passed.  Usually
842b39c5158Smillertthe case is you've got some complicated condition that is difficult to
843b8851fccSafresh1wedge into an C<ok()>.  In this case, you can simply use C<pass()> (to
844b39c5158Smillertdeclare the test ok) or fail (for not ok).  They are synonyms for
845b8851fccSafresh1C<ok(1)> and C<ok(0)>.
846b39c5158Smillert
847b39c5158SmillertUse these very, very, very sparingly.
848b39c5158Smillert
849b39c5158Smillert=cut
850b39c5158Smillert
851b39c5158Smillertsub pass (;$) {
852b39c5158Smillert    my $tb = Test::More->builder;
853b39c5158Smillert
854b39c5158Smillert    return $tb->ok( 1, @_ );
855b39c5158Smillert}
856b39c5158Smillert
857b39c5158Smillertsub fail (;$) {
858b39c5158Smillert    my $tb = Test::More->builder;
859b39c5158Smillert
860b39c5158Smillert    return $tb->ok( 0, @_ );
861b39c5158Smillert}
862b39c5158Smillert
863b39c5158Smillert=back
864b39c5158Smillert
865b39c5158Smillert
866b39c5158Smillert=head2 Module tests
867b39c5158Smillert
868e5157e49Safresh1Sometimes you want to test if a module, or a list of modules, can
869e5157e49Safresh1successfully load.  For example, you'll often want a first test which
870e5157e49Safresh1simply loads all the modules in the distribution to make sure they
871e5157e49Safresh1work before going on to do more complicated testing.
872e5157e49Safresh1
873e5157e49Safresh1For such purposes we have C<use_ok> and C<require_ok>.
874b39c5158Smillert
875b39c5158Smillert=over 4
876b39c5158Smillert
877b39c5158Smillert=item B<require_ok>
878b39c5158Smillert
879b39c5158Smillert   require_ok($module);
880b39c5158Smillert   require_ok($file);
881b39c5158Smillert
882e5157e49Safresh1Tries to C<require> the given $module or $file.  If it loads
883e5157e49Safresh1successfully, the test will pass.  Otherwise it fails and displays the
884e5157e49Safresh1load error.
885e5157e49Safresh1
886e5157e49Safresh1C<require_ok> will guess whether the input is a module name or a
887e5157e49Safresh1filename.
888e5157e49Safresh1
889e5157e49Safresh1No exception will be thrown if the load fails.
890e5157e49Safresh1
891e5157e49Safresh1    # require Some::Module
892e5157e49Safresh1    require_ok "Some::Module";
893e5157e49Safresh1
894e5157e49Safresh1    # require "Some/File.pl";
895e5157e49Safresh1    require_ok "Some/File.pl";
896e5157e49Safresh1
897e5157e49Safresh1    # stop testing if any of your modules will not load
898e5157e49Safresh1    for my $module (@module) {
899e5157e49Safresh1        require_ok $module or BAIL_OUT "Can't load $module";
900e5157e49Safresh1    }
901b39c5158Smillert
902b39c5158Smillert=cut
903b39c5158Smillert
904b39c5158Smillertsub require_ok ($) {
905b39c5158Smillert    my($module) = shift;
906b39c5158Smillert    my $tb = Test::More->builder;
907b39c5158Smillert
908b39c5158Smillert    my $pack = caller;
909b39c5158Smillert
91065d9bffcSjasper    # Try to determine if we've been given a module name or file.
911b39c5158Smillert    # Module names must be barewords, files not.
912b39c5158Smillert    $module = qq['$module'] unless _is_module_name($module);
913b39c5158Smillert
914b39c5158Smillert    my $code = <<REQUIRE;
915b39c5158Smillertpackage $pack;
916b39c5158Smillertrequire $module;
917b39c5158Smillert1;
918b39c5158SmillertREQUIRE
919b39c5158Smillert
920b39c5158Smillert    my( $eval_result, $eval_error ) = _eval($code);
921b39c5158Smillert    my $ok = $tb->ok( $eval_result, "require $module;" );
922b39c5158Smillert
923b39c5158Smillert    unless($ok) {
924b39c5158Smillert        chomp $eval_error;
925b39c5158Smillert        $tb->diag(<<DIAGNOSTIC);
926b39c5158Smillert    Tried to require '$module'.
927b39c5158Smillert    Error:  $eval_error
928b39c5158SmillertDIAGNOSTIC
929b39c5158Smillert
930b39c5158Smillert    }
931b39c5158Smillert
932b39c5158Smillert    return $ok;
933b39c5158Smillert}
934b39c5158Smillert
935b39c5158Smillertsub _is_module_name {
936b39c5158Smillert    my $module = shift;
937b39c5158Smillert
938b39c5158Smillert    # Module names start with a letter.
939b39c5158Smillert    # End with an alphanumeric.
940b39c5158Smillert    # The rest is an alphanumeric or ::
941b39c5158Smillert    $module =~ s/\b::\b//g;
942b39c5158Smillert
943b39c5158Smillert    return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
944b39c5158Smillert}
945b39c5158Smillert
946e5157e49Safresh1
947e5157e49Safresh1=item B<use_ok>
948e5157e49Safresh1
949e5157e49Safresh1   BEGIN { use_ok($module); }
950e5157e49Safresh1   BEGIN { use_ok($module, @imports); }
951e5157e49Safresh1
952e5157e49Safresh1Like C<require_ok>, but it will C<use> the $module in question and
953e5157e49Safresh1only loads modules, not files.
954e5157e49Safresh1
955e5157e49Safresh1If you just want to test a module can be loaded, use C<require_ok>.
956e5157e49Safresh1
957e5157e49Safresh1If you just want to load a module in a test, we recommend simply using
958e5157e49Safresh1C<use> directly.  It will cause the test to stop.
959e5157e49Safresh1
960b8851fccSafresh1It's recommended that you run C<use_ok()> inside a BEGIN block so its
961e5157e49Safresh1functions are exported at compile-time and prototypes are properly
962e5157e49Safresh1honored.
963e5157e49Safresh1
964e5157e49Safresh1If @imports are given, they are passed through to the use.  So this:
965e5157e49Safresh1
966e5157e49Safresh1   BEGIN { use_ok('Some::Module', qw(foo bar)) }
967e5157e49Safresh1
968e5157e49Safresh1is like doing this:
969e5157e49Safresh1
970e5157e49Safresh1   use Some::Module qw(foo bar);
971e5157e49Safresh1
972e5157e49Safresh1Version numbers can be checked like so:
973e5157e49Safresh1
974e5157e49Safresh1   # Just like "use Some::Module 1.02"
975e5157e49Safresh1   BEGIN { use_ok('Some::Module', 1.02) }
976e5157e49Safresh1
977e5157e49Safresh1Don't try to do this:
978e5157e49Safresh1
979e5157e49Safresh1   BEGIN {
980e5157e49Safresh1       use_ok('Some::Module');
981e5157e49Safresh1
982e5157e49Safresh1       ...some code that depends on the use...
983e5157e49Safresh1       ...happening at compile time...
984e5157e49Safresh1   }
985e5157e49Safresh1
986e5157e49Safresh1because the notion of "compile-time" is relative.  Instead, you want:
987e5157e49Safresh1
988e5157e49Safresh1  BEGIN { use_ok('Some::Module') }
989e5157e49Safresh1  BEGIN { ...some code that depends on the use... }
990e5157e49Safresh1
991e5157e49Safresh1If you want the equivalent of C<use Foo ()>, use a module but not
992e5157e49Safresh1import anything, use C<require_ok>.
993e5157e49Safresh1
994e5157e49Safresh1  BEGIN { require_ok "Foo" }
995e5157e49Safresh1
996e5157e49Safresh1=cut
997e5157e49Safresh1
998e5157e49Safresh1sub use_ok ($;@) {
999e5157e49Safresh1    my( $module, @imports ) = @_;
1000e5157e49Safresh1    @imports = () unless @imports;
1001e5157e49Safresh1    my $tb = Test::More->builder;
1002e5157e49Safresh1
10039f11ffb7Safresh1    my %caller;
10049f11ffb7Safresh1    @caller{qw/pack file line sub args want eval req strict warn/} = caller(0);
10059f11ffb7Safresh1
10069f11ffb7Safresh1    my ($pack, $filename, $line, $warn) = @caller{qw/pack file line warn/};
1007e5157e49Safresh1    $filename =~ y/\n\r/_/; # so it doesn't run off the "#line $line $f" line
1008e5157e49Safresh1
1009e5157e49Safresh1    my $code;
1010e5157e49Safresh1    if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
1011e5157e49Safresh1        # probably a version check.  Perl needs to see the bare number
1012e5157e49Safresh1        # for it to work with non-Exporter based modules.
1013e5157e49Safresh1        $code = <<USE;
1014e5157e49Safresh1package $pack;
10159f11ffb7Safresh1BEGIN { \${^WARNING_BITS} = \$args[-1] if defined \$args[-1] }
1016e5157e49Safresh1#line $line $filename
1017e5157e49Safresh1use $module $imports[0];
1018e5157e49Safresh11;
1019e5157e49Safresh1USE
1020e5157e49Safresh1    }
1021e5157e49Safresh1    else {
1022e5157e49Safresh1        $code = <<USE;
1023e5157e49Safresh1package $pack;
10249f11ffb7Safresh1BEGIN { \${^WARNING_BITS} = \$args[-1] if defined \$args[-1] }
1025e5157e49Safresh1#line $line $filename
1026e5157e49Safresh1use $module \@{\$args[0]};
1027e5157e49Safresh11;
1028e5157e49Safresh1USE
1029e5157e49Safresh1    }
1030e5157e49Safresh1
10319f11ffb7Safresh1    my ($eval_result, $eval_error) = _eval($code, \@imports, $warn);
1032e5157e49Safresh1    my $ok = $tb->ok( $eval_result, "use $module;" );
1033e5157e49Safresh1
1034e5157e49Safresh1    unless($ok) {
1035e5157e49Safresh1        chomp $eval_error;
1036e5157e49Safresh1        $@ =~ s{^BEGIN failed--compilation aborted at .*$}
1037e5157e49Safresh1                {BEGIN failed--compilation aborted at $filename line $line.}m;
1038e5157e49Safresh1        $tb->diag(<<DIAGNOSTIC);
1039e5157e49Safresh1    Tried to use '$module'.
1040e5157e49Safresh1    Error:  $eval_error
1041e5157e49Safresh1DIAGNOSTIC
1042e5157e49Safresh1
1043e5157e49Safresh1    }
1044e5157e49Safresh1
1045e5157e49Safresh1    return $ok;
1046e5157e49Safresh1}
1047e5157e49Safresh1
1048e5157e49Safresh1sub _eval {
1049e5157e49Safresh1    my( $code, @args ) = @_;
1050e5157e49Safresh1
1051e5157e49Safresh1    # Work around oddities surrounding resetting of $@ by immediately
1052e5157e49Safresh1    # storing it.
1053e5157e49Safresh1    my( $sigdie, $eval_result, $eval_error );
1054e5157e49Safresh1    {
1055e5157e49Safresh1        local( $@, $!, $SIG{__DIE__} );    # isolate eval
1056e5157e49Safresh1        $eval_result = eval $code;              ## no critic (BuiltinFunctions::ProhibitStringyEval)
1057e5157e49Safresh1        $eval_error  = $@;
1058e5157e49Safresh1        $sigdie      = $SIG{__DIE__} || undef;
1059e5157e49Safresh1    }
1060e5157e49Safresh1    # make sure that $code got a chance to set $SIG{__DIE__}
1061e5157e49Safresh1    $SIG{__DIE__} = $sigdie if defined $sigdie;
1062e5157e49Safresh1
1063e5157e49Safresh1    return( $eval_result, $eval_error );
1064e5157e49Safresh1}
1065e5157e49Safresh1
1066e5157e49Safresh1
1067b39c5158Smillert=back
1068b39c5158Smillert
1069b39c5158Smillert
1070b39c5158Smillert=head2 Complex data structures
1071b39c5158Smillert
1072b39c5158SmillertNot everything is a simple eq check or regex.  There are times you
1073b39c5158Smillertneed to see if two data structures are equivalent.  For these
1074b39c5158Smillertinstances Test::More provides a handful of useful functions.
1075b39c5158Smillert
1076b39c5158SmillertB<NOTE> I'm not quite sure what will happen with filehandles.
1077b39c5158Smillert
1078b39c5158Smillert=over 4
1079b39c5158Smillert
1080b39c5158Smillert=item B<is_deeply>
1081b39c5158Smillert
1082b39c5158Smillert  is_deeply( $got, $expected, $test_name );
1083b39c5158Smillert
1084b8851fccSafresh1Similar to C<is()>, except that if $got and $expected are references, it
1085b39c5158Smillertdoes a deep comparison walking each data structure to see if they are
1086b39c5158Smillertequivalent.  If the two structures are different, it will display the
1087b39c5158Smillertplace where they start differing.
1088b39c5158Smillert
1089b8851fccSafresh1C<is_deeply()> compares the dereferenced values of references, the
1090b39c5158Smillertreferences themselves (except for their type) are ignored.  This means
1091b39c5158Smillertaspects such as blessing and ties are not considered "different".
1092b39c5158Smillert
1093b8851fccSafresh1C<is_deeply()> currently has very limited handling of function reference
1094b39c5158Smillertand globs.  It merely checks if they have the same referent.  This may
1095b39c5158Smillertimprove in the future.
1096b39c5158Smillert
1097b39c5158SmillertL<Test::Differences> and L<Test::Deep> provide more in-depth functionality
1098b39c5158Smillertalong these lines.
1099b39c5158Smillert
11009f11ffb7Safresh1B<NOTE> is_deeply() has limitations when it comes to comparing strings and
11019f11ffb7Safresh1refs:
11029f11ffb7Safresh1
11039f11ffb7Safresh1    my $path = path('.');
11049f11ffb7Safresh1    my $hash = {};
11059f11ffb7Safresh1    is_deeply( $path, "$path" ); # ok
11069f11ffb7Safresh1    is_deeply( $hash, "$hash" ); # fail
11079f11ffb7Safresh1
11089f11ffb7Safresh1This happens because is_deeply will unoverload all arguments unconditionally.
11099f11ffb7Safresh1It is probably best not to use is_deeply with overloading. For legacy reasons
11109f11ffb7Safresh1this is not likely to ever be fixed. If you would like a much better tool for
11119f11ffb7Safresh1this you should see L<Test2::Suite> Specifically L<Test2::Tools::Compare> has
11129f11ffb7Safresh1an C<is()> function that works like C<is_deeply> with many improvements.
11139f11ffb7Safresh1
1114b39c5158Smillert=cut
1115b39c5158Smillert
1116b39c5158Smillertour( @Data_Stack, %Refs_Seen );
1117b39c5158Smillertmy $DNE = bless [], 'Does::Not::Exist';
1118b39c5158Smillert
1119b39c5158Smillertsub _dne {
1120b39c5158Smillert    return ref $_[0] eq ref $DNE;
1121b39c5158Smillert}
1122b39c5158Smillert
1123b39c5158Smillert## no critic (Subroutines::RequireArgUnpacking)
1124b39c5158Smillertsub is_deeply {
1125b39c5158Smillert    my $tb = Test::More->builder;
1126b39c5158Smillert
1127b39c5158Smillert    unless( @_ == 2 or @_ == 3 ) {
1128b39c5158Smillert        my $msg = <<'WARNING';
1129b39c5158Smillertis_deeply() takes two or three args, you gave %d.
1130b39c5158SmillertThis usually means you passed an array or hash instead
1131b39c5158Smillertof a reference to it
1132b39c5158SmillertWARNING
1133b39c5158Smillert        chop $msg;    # clip off newline so carp() will put in line/file
1134b39c5158Smillert
1135b39c5158Smillert        _carp sprintf $msg, scalar @_;
1136b39c5158Smillert
1137b39c5158Smillert        return $tb->ok(0);
1138b39c5158Smillert    }
1139b39c5158Smillert
1140b39c5158Smillert    my( $got, $expected, $name ) = @_;
1141b39c5158Smillert
1142b39c5158Smillert    $tb->_unoverload_str( \$expected, \$got );
1143b39c5158Smillert
1144b39c5158Smillert    my $ok;
1145b39c5158Smillert    if( !ref $got and !ref $expected ) {    # neither is a reference
1146b39c5158Smillert        $ok = $tb->is_eq( $got, $expected, $name );
1147b39c5158Smillert    }
1148b39c5158Smillert    elsif( !ref $got xor !ref $expected ) {    # one's a reference, one isn't
1149b39c5158Smillert        $ok = $tb->ok( 0, $name );
1150b39c5158Smillert        $tb->diag( _format_stack({ vals => [ $got, $expected ] }) );
1151b39c5158Smillert    }
1152b39c5158Smillert    else {                                     # both references
1153b39c5158Smillert        local @Data_Stack = ();
1154b39c5158Smillert        if( _deep_check( $got, $expected ) ) {
1155b39c5158Smillert            $ok = $tb->ok( 1, $name );
1156b39c5158Smillert        }
1157b39c5158Smillert        else {
1158b39c5158Smillert            $ok = $tb->ok( 0, $name );
1159b39c5158Smillert            $tb->diag( _format_stack(@Data_Stack) );
1160b39c5158Smillert        }
1161b39c5158Smillert    }
1162b39c5158Smillert
1163b39c5158Smillert    return $ok;
1164b39c5158Smillert}
1165b39c5158Smillert
1166b39c5158Smillertsub _format_stack {
1167b39c5158Smillert    my(@Stack) = @_;
1168b39c5158Smillert
1169b39c5158Smillert    my $var       = '$FOO';
1170b39c5158Smillert    my $did_arrow = 0;
1171b39c5158Smillert    foreach my $entry (@Stack) {
1172b39c5158Smillert        my $type = $entry->{type} || '';
1173b39c5158Smillert        my $idx = $entry->{'idx'};
1174b39c5158Smillert        if( $type eq 'HASH' ) {
1175b39c5158Smillert            $var .= "->" unless $did_arrow++;
1176b39c5158Smillert            $var .= "{$idx}";
1177b39c5158Smillert        }
1178b39c5158Smillert        elsif( $type eq 'ARRAY' ) {
1179b39c5158Smillert            $var .= "->" unless $did_arrow++;
1180b39c5158Smillert            $var .= "[$idx]";
1181b39c5158Smillert        }
1182b39c5158Smillert        elsif( $type eq 'REF' ) {
1183b39c5158Smillert            $var = "\${$var}";
1184b39c5158Smillert        }
1185b39c5158Smillert    }
1186b39c5158Smillert
1187b39c5158Smillert    my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ];
1188b39c5158Smillert    my @vars = ();
1189b39c5158Smillert    ( $vars[0] = $var ) =~ s/\$FOO/     \$got/;
1190b39c5158Smillert    ( $vars[1] = $var ) =~ s/\$FOO/\$expected/;
1191b39c5158Smillert
1192b39c5158Smillert    my $out = "Structures begin differing at:\n";
1193b39c5158Smillert    foreach my $idx ( 0 .. $#vals ) {
1194b39c5158Smillert        my $val = $vals[$idx];
1195b39c5158Smillert        $vals[$idx]
1196b39c5158Smillert          = !defined $val ? 'undef'
1197b39c5158Smillert          : _dne($val)    ? "Does not exist"
1198b39c5158Smillert          : ref $val      ? "$val"
1199b39c5158Smillert          :                 "'$val'";
1200b39c5158Smillert    }
1201b39c5158Smillert
1202b39c5158Smillert    $out .= "$vars[0] = $vals[0]\n";
1203b39c5158Smillert    $out .= "$vars[1] = $vals[1]\n";
1204b39c5158Smillert
1205b39c5158Smillert    $out =~ s/^/    /msg;
1206b39c5158Smillert    return $out;
1207b39c5158Smillert}
1208b39c5158Smillert
1209*3d61058aSafresh1my %_types = (
1210*3d61058aSafresh1  (map +($_ => $_), qw(
1211*3d61058aSafresh1    Regexp
1212*3d61058aSafresh1    ARRAY
1213*3d61058aSafresh1    HASH
1214*3d61058aSafresh1    SCALAR
1215*3d61058aSafresh1    REF
1216*3d61058aSafresh1    GLOB
1217*3d61058aSafresh1    CODE
1218*3d61058aSafresh1  )),
1219*3d61058aSafresh1  'LVALUE'  => 'SCALAR',
1220*3d61058aSafresh1  'REF'     => 'SCALAR',
1221*3d61058aSafresh1  'VSTRING' => 'SCALAR',
1222*3d61058aSafresh1);
1223*3d61058aSafresh1
1224b39c5158Smillertsub _type {
1225b39c5158Smillert    my $thing = shift;
1226b39c5158Smillert
1227b39c5158Smillert    return '' if !ref $thing;
1228b39c5158Smillert
1229*3d61058aSafresh1    for my $type (keys %_types) {
1230*3d61058aSafresh1        return $_types{$type} if UNIVERSAL::isa( $thing, $type );
1231b39c5158Smillert    }
1232b39c5158Smillert
1233b39c5158Smillert    return '';
1234b39c5158Smillert}
1235b39c5158Smillert
1236b39c5158Smillert=back
1237b39c5158Smillert
1238b39c5158Smillert
1239b39c5158Smillert=head2 Diagnostics
1240b39c5158Smillert
1241b39c5158SmillertIf you pick the right test function, you'll usually get a good idea of
1242b39c5158Smillertwhat went wrong when it failed.  But sometimes it doesn't work out
1243b39c5158Smillertthat way.  So here we have ways for you to write your own diagnostic
1244b39c5158Smillertmessages which are safer than just C<print STDERR>.
1245b39c5158Smillert
1246b39c5158Smillert=over 4
1247b39c5158Smillert
1248b39c5158Smillert=item B<diag>
1249b39c5158Smillert
1250b39c5158Smillert  diag(@diagnostic_message);
1251b39c5158Smillert
1252b39c5158SmillertPrints a diagnostic message which is guaranteed not to interfere with
1253b39c5158Smillerttest output.  Like C<print> @diagnostic_message is simply concatenated
1254b39c5158Smillerttogether.
1255b39c5158Smillert
1256b39c5158SmillertReturns false, so as to preserve failure.
1257b39c5158Smillert
1258b39c5158SmillertHandy for this sort of thing:
1259b39c5158Smillert
1260b39c5158Smillert    ok( grep(/foo/, @users), "There's a foo user" ) or
1261b39c5158Smillert        diag("Since there's no foo, check that /etc/bar is set up right");
1262b39c5158Smillert
1263b39c5158Smillertwhich would produce:
1264b39c5158Smillert
1265b39c5158Smillert    not ok 42 - There's a foo user
1266b39c5158Smillert    #   Failed test 'There's a foo user'
1267b39c5158Smillert    #   in foo.t at line 52.
1268b39c5158Smillert    # Since there's no foo, check that /etc/bar is set up right.
1269b39c5158Smillert
1270b39c5158SmillertYou might remember C<ok() or diag()> with the mnemonic C<open() or
1271b39c5158Smillertdie()>.
1272b39c5158Smillert
1273b39c5158SmillertB<NOTE> The exact formatting of the diagnostic output is still
1274e5157e49Safresh1changing, but it is guaranteed that whatever you throw at it won't
1275b39c5158Smillertinterfere with the test.
1276b39c5158Smillert
1277b39c5158Smillert=item B<note>
1278b39c5158Smillert
1279b39c5158Smillert  note(@diagnostic_message);
1280b39c5158Smillert
1281b8851fccSafresh1Like C<diag()>, except the message will not be seen when the test is run
1282b39c5158Smillertin a harness.  It will only be visible in the verbose TAP stream.
1283b39c5158Smillert
1284b39c5158SmillertHandy for putting in notes which might be useful for debugging, but
1285b39c5158Smillertdon't indicate a problem.
1286b39c5158Smillert
1287b39c5158Smillert    note("Tempfile is $tempfile");
1288b39c5158Smillert
1289b39c5158Smillert=cut
1290b39c5158Smillert
1291b39c5158Smillertsub diag {
1292b39c5158Smillert    return Test::More->builder->diag(@_);
1293b39c5158Smillert}
1294b39c5158Smillert
1295b39c5158Smillertsub note {
1296b39c5158Smillert    return Test::More->builder->note(@_);
1297b39c5158Smillert}
1298b39c5158Smillert
1299b39c5158Smillert=item B<explain>
1300b39c5158Smillert
1301b39c5158Smillert  my @dump = explain @diagnostic_message;
1302b39c5158Smillert
1303b39c5158SmillertWill dump the contents of any references in a human readable format.
1304b39c5158SmillertUsually you want to pass this into C<note> or C<diag>.
1305b39c5158Smillert
1306b39c5158SmillertHandy for things like...
1307b39c5158Smillert
1308b39c5158Smillert    is_deeply($have, $want) || diag explain $have;
1309b39c5158Smillert
1310b39c5158Smillertor
1311b39c5158Smillert
1312b39c5158Smillert    note explain \%args;
1313b39c5158Smillert    Some::Class->method(%args);
1314b39c5158Smillert
1315b39c5158Smillert=cut
1316b39c5158Smillert
1317b39c5158Smillertsub explain {
1318b39c5158Smillert    return Test::More->builder->explain(@_);
1319b39c5158Smillert}
1320b39c5158Smillert
1321b39c5158Smillert=back
1322b39c5158Smillert
1323b39c5158Smillert
1324b39c5158Smillert=head2 Conditional tests
1325b39c5158Smillert
1326b39c5158SmillertSometimes running a test under certain conditions will cause the
1327b39c5158Smillerttest script to die.  A certain function or method isn't implemented
1328b8851fccSafresh1(such as C<fork()> on MacOS), some resource isn't available (like a
1329b39c5158Smillertnet connection) or a module isn't available.  In these cases it's
1330b39c5158Smillertnecessary to skip tests, or declare that they are supposed to fail
1331b39c5158Smillertbut will work in the future (a todo test).
1332b39c5158Smillert
1333b39c5158SmillertFor more details on the mechanics of skip and todo tests see
1334b39c5158SmillertL<Test::Harness>.
1335b39c5158Smillert
1336b39c5158SmillertThe way Test::More handles this is with a named block.  Basically, a
1337b39c5158Smillertblock of tests which can be skipped over or made todo.  It's best if I
1338b39c5158Smillertjust show you...
1339b39c5158Smillert
1340b39c5158Smillert=over 4
1341b39c5158Smillert
1342b39c5158Smillert=item B<SKIP: BLOCK>
1343b39c5158Smillert
1344b39c5158Smillert  SKIP: {
1345b39c5158Smillert      skip $why, $how_many if $condition;
1346b39c5158Smillert
1347b39c5158Smillert      ...normal testing code goes here...
1348b39c5158Smillert  }
1349b39c5158Smillert
1350b39c5158SmillertThis declares a block of tests that might be skipped, $how_many tests
1351b39c5158Smillertthere are, $why and under what $condition to skip them.  An example is
1352b39c5158Smillertthe easiest way to illustrate:
1353b39c5158Smillert
1354b39c5158Smillert    SKIP: {
1355b39c5158Smillert        eval { require HTML::Lint };
1356b39c5158Smillert
1357b39c5158Smillert        skip "HTML::Lint not installed", 2 if $@;
1358b39c5158Smillert
1359b39c5158Smillert        my $lint = new HTML::Lint;
1360b39c5158Smillert        isa_ok( $lint, "HTML::Lint" );
1361b39c5158Smillert
1362b39c5158Smillert        $lint->parse( $html );
1363b39c5158Smillert        is( $lint->errors, 0, "No errors found in HTML" );
1364b39c5158Smillert    }
1365b39c5158Smillert
1366b39c5158SmillertIf the user does not have HTML::Lint installed, the whole block of
1367b39c5158Smillertcode I<won't be run at all>.  Test::More will output special ok's
1368b39c5158Smillertwhich Test::Harness interprets as skipped, but passing, tests.
1369b39c5158Smillert
1370b39c5158SmillertIt's important that $how_many accurately reflects the number of tests
1371b39c5158Smillertin the SKIP block so the # of tests run will match up with your plan.
1372b39c5158SmillertIf your plan is C<no_plan> $how_many is optional and will default to 1.
1373b39c5158Smillert
1374b39c5158SmillertIt's perfectly safe to nest SKIP blocks.  Each SKIP block must have
1375b39c5158Smillertthe label C<SKIP>, or Test::More can't work its magic.
1376b39c5158Smillert
1377b39c5158SmillertYou don't skip tests which are failing because there's a bug in your
1378b39c5158Smillertprogram, or for which you don't yet have code written.  For that you
1379b39c5158Smillertuse TODO.  Read on.
1380b39c5158Smillert
1381b39c5158Smillert=cut
1382b39c5158Smillert
1383b39c5158Smillert## no critic (Subroutines::RequireFinalReturn)
1384b39c5158Smillertsub skip {
1385b39c5158Smillert    my( $why, $how_many ) = @_;
1386b39c5158Smillert    my $tb = Test::More->builder;
1387b39c5158Smillert
13889f11ffb7Safresh1    # If the plan is set, and is static, then skip needs a count. If the plan
13899f11ffb7Safresh1    # is 'no_plan' we are fine. As well if plan is undefined then we are
13909f11ffb7Safresh1    # waiting for done_testing.
1391b39c5158Smillert    unless (defined $how_many) {
13929f11ffb7Safresh1        my $plan = $tb->has_plan;
1393b39c5158Smillert        _carp "skip() needs to know \$how_many tests are in the block"
13949f11ffb7Safresh1            if $plan && $plan =~ m/^\d+$/;
1395b39c5158Smillert        $how_many = 1;
1396b39c5158Smillert    }
1397b39c5158Smillert
1398b39c5158Smillert    if( defined $how_many and $how_many =~ /\D/ ) {
1399b39c5158Smillert        _carp
1400b39c5158Smillert          "skip() was passed a non-numeric number of tests.  Did you get the arguments backwards?";
1401b39c5158Smillert        $how_many = 1;
1402b39c5158Smillert    }
1403b39c5158Smillert
1404b39c5158Smillert    for( 1 .. $how_many ) {
1405b39c5158Smillert        $tb->skip($why);
1406b39c5158Smillert    }
1407b39c5158Smillert
1408b39c5158Smillert    no warnings 'exiting';
1409b39c5158Smillert    last SKIP;
1410b39c5158Smillert}
1411b39c5158Smillert
1412b39c5158Smillert=item B<TODO: BLOCK>
1413b39c5158Smillert
1414b39c5158Smillert    TODO: {
1415b39c5158Smillert        local $TODO = $why if $condition;
1416b39c5158Smillert
1417b39c5158Smillert        ...normal testing code goes here...
1418b39c5158Smillert    }
1419b39c5158Smillert
1420b39c5158SmillertDeclares a block of tests you expect to fail and $why.  Perhaps it's
1421b39c5158Smillertbecause you haven't fixed a bug or haven't finished a new feature:
1422b39c5158Smillert
1423b39c5158Smillert    TODO: {
1424b39c5158Smillert        local $TODO = "URI::Geller not finished";
1425b39c5158Smillert
1426b39c5158Smillert        my $card = "Eight of clubs";
1427b39c5158Smillert        is( URI::Geller->your_card, $card, 'Is THIS your card?' );
1428b39c5158Smillert
1429b39c5158Smillert        my $spoon;
1430b39c5158Smillert        URI::Geller->bend_spoon;
1431b39c5158Smillert        is( $spoon, 'bent',    "Spoon bending, that's original" );
1432b39c5158Smillert    }
1433b39c5158Smillert
1434b39c5158SmillertWith a todo block, the tests inside are expected to fail.  Test::More
1435b39c5158Smillertwill run the tests normally, but print out special flags indicating
1436b8851fccSafresh1they are "todo".  L<Test::Harness> will interpret failures as being ok.
1437b39c5158SmillertShould anything succeed, it will report it as an unexpected success.
1438b39c5158SmillertYou then know the thing you had todo is done and can remove the
1439b39c5158SmillertTODO flag.
1440b39c5158Smillert
1441b39c5158SmillertThe nice part about todo tests, as opposed to simply commenting out a
144256d68f1eSafresh1block of tests, is that it is like having a programmatic todo list.  You know
1443b39c5158Smillerthow much work is left to be done, you're aware of what bugs there are,
1444b39c5158Smillertand you'll know immediately when they're fixed.
1445b39c5158Smillert
1446b39c5158SmillertOnce a todo test starts succeeding, simply move it outside the block.
1447b39c5158SmillertWhen the block is empty, delete it.
1448b39c5158Smillert
1449eac174f2Safresh1Note that, if you leave $TODO unset or undef, Test::More reports failures
1450eac174f2Safresh1as normal. This can be useful to mark the tests as expected to fail only
1451eac174f2Safresh1in certain conditions, e.g.:
1452eac174f2Safresh1
1453eac174f2Safresh1    TODO: {
1454eac174f2Safresh1        local $TODO = "$^O doesn't work yet. :(" if !_os_is_supported($^O);
1455eac174f2Safresh1
1456eac174f2Safresh1        ...
1457eac174f2Safresh1    }
1458b39c5158Smillert
1459b39c5158Smillert=item B<todo_skip>
1460b39c5158Smillert
1461b39c5158Smillert    TODO: {
1462b39c5158Smillert        todo_skip $why, $how_many if $condition;
1463b39c5158Smillert
1464b39c5158Smillert        ...normal testing code...
1465b39c5158Smillert    }
1466b39c5158Smillert
1467b39c5158SmillertWith todo tests, it's best to have the tests actually run.  That way
1468b39c5158Smillertyou'll know when they start passing.  Sometimes this isn't possible.
1469b39c5158SmillertOften a failing test will cause the whole program to die or hang, even
1470b39c5158Smillertinside an C<eval BLOCK> with and using C<alarm>.  In these extreme
1471b39c5158Smillertcases you have no choice but to skip over the broken tests entirely.
1472b39c5158Smillert
1473b39c5158SmillertThe syntax and behavior is similar to a C<SKIP: BLOCK> except the
1474b8851fccSafresh1tests will be marked as failing but todo.  L<Test::Harness> will
1475b39c5158Smillertinterpret them as passing.
1476b39c5158Smillert
1477b39c5158Smillert=cut
1478b39c5158Smillert
1479b39c5158Smillertsub todo_skip {
1480b39c5158Smillert    my( $why, $how_many ) = @_;
1481b39c5158Smillert    my $tb = Test::More->builder;
1482b39c5158Smillert
1483b39c5158Smillert    unless( defined $how_many ) {
1484b39c5158Smillert        # $how_many can only be avoided when no_plan is in use.
1485b39c5158Smillert        _carp "todo_skip() needs to know \$how_many tests are in the block"
1486b39c5158Smillert          unless $tb->has_plan eq 'no_plan';
1487b39c5158Smillert        $how_many = 1;
1488b39c5158Smillert    }
1489b39c5158Smillert
1490b39c5158Smillert    for( 1 .. $how_many ) {
1491b39c5158Smillert        $tb->todo_skip($why);
1492b39c5158Smillert    }
1493b39c5158Smillert
1494b39c5158Smillert    no warnings 'exiting';
1495b39c5158Smillert    last TODO;
1496b39c5158Smillert}
1497b39c5158Smillert
1498b39c5158Smillert=item When do I use SKIP vs. TODO?
1499b39c5158Smillert
1500b39c5158SmillertB<If it's something the user might not be able to do>, use SKIP.
1501b39c5158SmillertThis includes optional modules that aren't installed, running under
1502b8851fccSafresh1an OS that doesn't have some feature (like C<fork()> or symlinks), or maybe
1503b39c5158Smillertyou need an Internet connection and one isn't available.
1504b39c5158Smillert
1505b39c5158SmillertB<If it's something the programmer hasn't done yet>, use TODO.  This
1506b39c5158Smillertis for any code you haven't written yet, or bugs you have yet to fix,
1507b39c5158Smillertbut want to put tests in your testing script (always a good idea).
1508b39c5158Smillert
1509b39c5158Smillert
1510b39c5158Smillert=back
1511b39c5158Smillert
1512b39c5158Smillert
1513b39c5158Smillert=head2 Test control
1514b39c5158Smillert
1515b39c5158Smillert=over 4
1516b39c5158Smillert
1517b39c5158Smillert=item B<BAIL_OUT>
1518b39c5158Smillert
1519b39c5158Smillert    BAIL_OUT($reason);
1520b39c5158Smillert
1521b39c5158SmillertIndicates to the harness that things are going so badly all testing
152265d9bffcSjaspershould terminate.  This includes the running of any additional test scripts.
1523b39c5158Smillert
1524b39c5158SmillertThis is typically used when testing cannot continue such as a critical
1525b39c5158Smillertmodule failing to compile or a necessary external utility not being
1526b39c5158Smillertavailable such as a database connection failing.
1527b39c5158Smillert
1528b39c5158SmillertThe test will exit with 255.
1529b39c5158Smillert
1530b39c5158SmillertFor even better control look at L<Test::Most>.
1531b39c5158Smillert
1532b39c5158Smillert=cut
1533b39c5158Smillert
1534b39c5158Smillertsub BAIL_OUT {
1535b39c5158Smillert    my $reason = shift;
1536b39c5158Smillert    my $tb     = Test::More->builder;
1537b39c5158Smillert
1538b39c5158Smillert    $tb->BAIL_OUT($reason);
1539b39c5158Smillert}
1540b39c5158Smillert
1541b39c5158Smillert=back
1542b39c5158Smillert
1543b39c5158Smillert
1544b39c5158Smillert=head2 Discouraged comparison functions
1545b39c5158Smillert
1546b39c5158SmillertThe use of the following functions is discouraged as they are not
1547b39c5158Smillertactually testing functions and produce no diagnostics to help figure
1548b8851fccSafresh1out what went wrong.  They were written before C<is_deeply()> existed
1549b39c5158Smillertbecause I couldn't figure out how to display a useful diff of two
1550b39c5158Smillertarbitrary data structures.
1551b39c5158Smillert
1552b8851fccSafresh1These functions are usually used inside an C<ok()>.
1553b39c5158Smillert
1554b39c5158Smillert    ok( eq_array(\@got, \@expected) );
1555b39c5158Smillert
1556b39c5158SmillertC<is_deeply()> can do that better and with diagnostics.
1557b39c5158Smillert
1558b39c5158Smillert    is_deeply( \@got, \@expected );
1559b39c5158Smillert
1560b39c5158SmillertThey may be deprecated in future versions.
1561b39c5158Smillert
1562b39c5158Smillert=over 4
1563b39c5158Smillert
1564b39c5158Smillert=item B<eq_array>
1565b39c5158Smillert
1566b39c5158Smillert  my $is_eq = eq_array(\@got, \@expected);
1567b39c5158Smillert
1568b39c5158SmillertChecks if two arrays are equivalent.  This is a deep check, so
1569b39c5158Smillertmulti-level structures are handled correctly.
1570b39c5158Smillert
1571b39c5158Smillert=cut
1572b39c5158Smillert
1573b39c5158Smillert#'#
1574b39c5158Smillertsub eq_array {
1575b39c5158Smillert    local @Data_Stack = ();
1576b39c5158Smillert    _deep_check(@_);
1577b39c5158Smillert}
1578b39c5158Smillert
1579b39c5158Smillertsub _eq_array {
1580b39c5158Smillert    my( $a1, $a2 ) = @_;
1581b39c5158Smillert
1582b39c5158Smillert    if( grep _type($_) ne 'ARRAY', $a1, $a2 ) {
1583b39c5158Smillert        warn "eq_array passed a non-array ref";
1584b39c5158Smillert        return 0;
1585b39c5158Smillert    }
1586b39c5158Smillert
1587b39c5158Smillert    return 1 if $a1 eq $a2;
1588b39c5158Smillert
1589b39c5158Smillert    my $ok = 1;
1590b39c5158Smillert    my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
1591b39c5158Smillert    for( 0 .. $max ) {
1592b39c5158Smillert        my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
1593b39c5158Smillert        my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
1594b39c5158Smillert
159565d9bffcSjasper        next if _equal_nonrefs($e1, $e2);
159665d9bffcSjasper
1597b39c5158Smillert        push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] };
1598b39c5158Smillert        $ok = _deep_check( $e1, $e2 );
1599b39c5158Smillert        pop @Data_Stack if $ok;
1600b39c5158Smillert
1601b39c5158Smillert        last unless $ok;
1602b39c5158Smillert    }
1603b39c5158Smillert
1604b39c5158Smillert    return $ok;
1605b39c5158Smillert}
1606b39c5158Smillert
160765d9bffcSjaspersub _equal_nonrefs {
160865d9bffcSjasper    my( $e1, $e2 ) = @_;
160965d9bffcSjasper
161065d9bffcSjasper    return if ref $e1 or ref $e2;
161165d9bffcSjasper
161265d9bffcSjasper    if ( defined $e1 ) {
161365d9bffcSjasper        return 1 if defined $e2 and $e1 eq $e2;
161465d9bffcSjasper    }
161565d9bffcSjasper    else {
161665d9bffcSjasper        return 1 if !defined $e2;
161765d9bffcSjasper    }
161865d9bffcSjasper
161965d9bffcSjasper    return;
162065d9bffcSjasper}
162165d9bffcSjasper
1622b39c5158Smillertsub _deep_check {
1623b39c5158Smillert    my( $e1, $e2 ) = @_;
1624b39c5158Smillert    my $tb = Test::More->builder;
1625b39c5158Smillert
1626b39c5158Smillert    my $ok = 0;
1627b39c5158Smillert
1628b39c5158Smillert    # Effectively turn %Refs_Seen into a stack.  This avoids picking up
1629b39c5158Smillert    # the same referenced used twice (such as [\$a, \$a]) to be considered
1630b39c5158Smillert    # circular.
1631b39c5158Smillert    local %Refs_Seen = %Refs_Seen;
1632b39c5158Smillert
1633b39c5158Smillert    {
1634b39c5158Smillert        $tb->_unoverload_str( \$e1, \$e2 );
1635b39c5158Smillert
1636b39c5158Smillert        # Either they're both references or both not.
1637b39c5158Smillert        my $same_ref = !( !ref $e1 xor !ref $e2 );
1638b39c5158Smillert        my $not_ref = ( !ref $e1 and !ref $e2 );
1639b39c5158Smillert
1640b39c5158Smillert        if( defined $e1 xor defined $e2 ) {
1641b39c5158Smillert            $ok = 0;
1642b39c5158Smillert        }
1643b39c5158Smillert        elsif( !defined $e1 and !defined $e2 ) {
164465d9bffcSjasper            # Shortcut if they're both undefined.
1645b39c5158Smillert            $ok = 1;
1646b39c5158Smillert        }
1647b39c5158Smillert        elsif( _dne($e1) xor _dne($e2) ) {
1648b39c5158Smillert            $ok = 0;
1649b39c5158Smillert        }
1650b39c5158Smillert        elsif( $same_ref and( $e1 eq $e2 ) ) {
1651b39c5158Smillert            $ok = 1;
1652b39c5158Smillert        }
1653b39c5158Smillert        elsif($not_ref) {
1654b39c5158Smillert            push @Data_Stack, { type => '', vals => [ $e1, $e2 ] };
1655b39c5158Smillert            $ok = 0;
1656b39c5158Smillert        }
1657b39c5158Smillert        else {
1658b39c5158Smillert            if( $Refs_Seen{$e1} ) {
1659b39c5158Smillert                return $Refs_Seen{$e1} eq $e2;
1660b39c5158Smillert            }
1661b39c5158Smillert            else {
1662b39c5158Smillert                $Refs_Seen{$e1} = "$e2";
1663b39c5158Smillert            }
1664b39c5158Smillert
1665b39c5158Smillert            my $type = _type($e1);
1666b39c5158Smillert            $type = 'DIFFERENT' unless _type($e2) eq $type;
1667b39c5158Smillert
1668b39c5158Smillert            if( $type eq 'DIFFERENT' ) {
1669b39c5158Smillert                push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1670b39c5158Smillert                $ok = 0;
1671b39c5158Smillert            }
1672b39c5158Smillert            elsif( $type eq 'ARRAY' ) {
1673b39c5158Smillert                $ok = _eq_array( $e1, $e2 );
1674b39c5158Smillert            }
1675b39c5158Smillert            elsif( $type eq 'HASH' ) {
1676b39c5158Smillert                $ok = _eq_hash( $e1, $e2 );
1677b39c5158Smillert            }
1678b39c5158Smillert            elsif( $type eq 'REF' ) {
1679b39c5158Smillert                push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1680b39c5158Smillert                $ok = _deep_check( $$e1, $$e2 );
1681b39c5158Smillert                pop @Data_Stack if $ok;
1682b39c5158Smillert            }
1683b39c5158Smillert            elsif( $type eq 'SCALAR' ) {
1684b39c5158Smillert                push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] };
1685b39c5158Smillert                $ok = _deep_check( $$e1, $$e2 );
1686b39c5158Smillert                pop @Data_Stack if $ok;
1687b39c5158Smillert            }
1688b39c5158Smillert            elsif($type) {
1689b39c5158Smillert                push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1690b39c5158Smillert                $ok = 0;
1691b39c5158Smillert            }
1692b39c5158Smillert            else {
1693b39c5158Smillert                _whoa( 1, "No type in _deep_check" );
1694b39c5158Smillert            }
1695b39c5158Smillert        }
1696b39c5158Smillert    }
1697b39c5158Smillert
1698b39c5158Smillert    return $ok;
1699b39c5158Smillert}
1700b39c5158Smillert
1701b39c5158Smillertsub _whoa {
1702b39c5158Smillert    my( $check, $desc ) = @_;
1703b39c5158Smillert    if($check) {
1704b39c5158Smillert        die <<"WHOA";
1705b39c5158SmillertWHOA!  $desc
1706b39c5158SmillertThis should never happen!  Please contact the author immediately!
1707b39c5158SmillertWHOA
1708b39c5158Smillert    }
1709b39c5158Smillert}
1710b39c5158Smillert
1711b39c5158Smillert=item B<eq_hash>
1712b39c5158Smillert
1713b39c5158Smillert  my $is_eq = eq_hash(\%got, \%expected);
1714b39c5158Smillert
1715b39c5158SmillertDetermines if the two hashes contain the same keys and values.  This
1716b39c5158Smillertis a deep check.
1717b39c5158Smillert
1718b39c5158Smillert=cut
1719b39c5158Smillert
1720b39c5158Smillertsub eq_hash {
1721b39c5158Smillert    local @Data_Stack = ();
1722b39c5158Smillert    return _deep_check(@_);
1723b39c5158Smillert}
1724b39c5158Smillert
1725b39c5158Smillertsub _eq_hash {
1726b39c5158Smillert    my( $a1, $a2 ) = @_;
1727b39c5158Smillert
1728b39c5158Smillert    if( grep _type($_) ne 'HASH', $a1, $a2 ) {
1729b39c5158Smillert        warn "eq_hash passed a non-hash ref";
1730b39c5158Smillert        return 0;
1731b39c5158Smillert    }
1732b39c5158Smillert
1733b39c5158Smillert    return 1 if $a1 eq $a2;
1734b39c5158Smillert
1735b39c5158Smillert    my $ok = 1;
1736b39c5158Smillert    my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
1737b39c5158Smillert    foreach my $k ( keys %$bigger ) {
1738b39c5158Smillert        my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
1739b39c5158Smillert        my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
1740b39c5158Smillert
174165d9bffcSjasper        next if _equal_nonrefs($e1, $e2);
174265d9bffcSjasper
1743b39c5158Smillert        push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] };
1744b39c5158Smillert        $ok = _deep_check( $e1, $e2 );
1745b39c5158Smillert        pop @Data_Stack if $ok;
1746b39c5158Smillert
1747b39c5158Smillert        last unless $ok;
1748b39c5158Smillert    }
1749b39c5158Smillert
1750b39c5158Smillert    return $ok;
1751b39c5158Smillert}
1752b39c5158Smillert
1753b39c5158Smillert=item B<eq_set>
1754b39c5158Smillert
1755b39c5158Smillert  my $is_eq = eq_set(\@got, \@expected);
1756b39c5158Smillert
1757b8851fccSafresh1Similar to C<eq_array()>, except the order of the elements is B<not>
1758b39c5158Smillertimportant.  This is a deep check, but the irrelevancy of order only
1759b39c5158Smillertapplies to the top level.
1760b39c5158Smillert
1761b39c5158Smillert    ok( eq_set(\@got, \@expected) );
1762b39c5158Smillert
1763b39c5158SmillertIs better written:
1764b39c5158Smillert
1765b39c5158Smillert    is_deeply( [sort @got], [sort @expected] );
1766b39c5158Smillert
1767b39c5158SmillertB<NOTE> By historical accident, this is not a true set comparison.
1768b39c5158SmillertWhile the order of elements does not matter, duplicate elements do.
1769b39c5158Smillert
1770b8851fccSafresh1B<NOTE> C<eq_set()> does not know how to deal with references at the top
1771b39c5158Smillertlevel.  The following is an example of a comparison which might not work:
1772b39c5158Smillert
1773b39c5158Smillert    eq_set([\1, \2], [\2, \1]);
1774b39c5158Smillert
1775b39c5158SmillertL<Test::Deep> contains much better set comparison functions.
1776b39c5158Smillert
1777b39c5158Smillert=cut
1778b39c5158Smillert
1779b39c5158Smillertsub eq_set {
1780b39c5158Smillert    my( $a1, $a2 ) = @_;
1781b39c5158Smillert    return 0 unless @$a1 == @$a2;
1782b39c5158Smillert
1783b39c5158Smillert    no warnings 'uninitialized';
1784b39c5158Smillert
1785b39c5158Smillert    # It really doesn't matter how we sort them, as long as both arrays are
1786b39c5158Smillert    # sorted with the same algorithm.
1787b39c5158Smillert    #
1788b39c5158Smillert    # Ensure that references are not accidentally treated the same as a
1789b39c5158Smillert    # string containing the reference.
1790b39c5158Smillert    #
1791b39c5158Smillert    # Have to inline the sort routine due to a threading/sort bug.
1792b39c5158Smillert    # See [rt.cpan.org 6782]
1793b39c5158Smillert    #
1794b39c5158Smillert    # I don't know how references would be sorted so we just don't sort
1795b39c5158Smillert    # them.  This means eq_set doesn't really work with refs.
1796b39c5158Smillert    return eq_array(
1797b39c5158Smillert        [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ],
1798b39c5158Smillert        [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ],
1799b39c5158Smillert    );
1800b39c5158Smillert}
1801b39c5158Smillert
1802b39c5158Smillert=back
1803b39c5158Smillert
1804b39c5158Smillert
1805b39c5158Smillert=head2 Extending and Embedding Test::More
1806b39c5158Smillert
1807b39c5158SmillertSometimes the Test::More interface isn't quite enough.  Fortunately,
1808b8851fccSafresh1Test::More is built on top of L<Test::Builder> which provides a single,
1809b39c5158Smillertunified backend for any test library to use.  This means two test
1810e0680481Safresh1libraries which both use L<Test::Builder> B<can> be used together in the
1811e0680481Safresh1same program.
1812b39c5158Smillert
1813b39c5158SmillertIf you simply want to do a little tweaking of how the tests behave,
1814b8851fccSafresh1you can access the underlying L<Test::Builder> object like so:
1815b39c5158Smillert
1816b39c5158Smillert=over 4
1817b39c5158Smillert
1818b39c5158Smillert=item B<builder>
1819b39c5158Smillert
1820b39c5158Smillert    my $test_builder = Test::More->builder;
1821b39c5158Smillert
1822b8851fccSafresh1Returns the L<Test::Builder> object underlying Test::More for you to play
1823b39c5158Smillertwith.
1824b39c5158Smillert
1825b39c5158Smillert
1826b39c5158Smillert=back
1827b39c5158Smillert
1828b39c5158Smillert
1829b39c5158Smillert=head1 EXIT CODES
1830b39c5158Smillert
1831b8851fccSafresh1If all your tests passed, L<Test::Builder> will exit with zero (which is
1832b39c5158Smillertnormal).  If anything failed it will exit with how many failed.  If
1833b39c5158Smillertyou run less (or more) tests than you planned, the missing (or extras)
1834b8851fccSafresh1will be considered failures.  If no tests were ever run L<Test::Builder>
1835b39c5158Smillertwill throw a warning and exit with 255.  If the test died, even after
1836b39c5158Smillerthaving successfully completed all its tests, it will still be
1837b39c5158Smillertconsidered a failure and will exit with 255.
1838b39c5158Smillert
1839b39c5158SmillertSo the exit codes are...
1840b39c5158Smillert
1841b39c5158Smillert    0                   all tests successful
1842b39c5158Smillert    255                 test died or all passed but wrong # of tests run
1843b39c5158Smillert    any other number    how many failed (including missing or extras)
1844b39c5158Smillert
1845b39c5158SmillertIf you fail more than 254 tests, it will be reported as 254.
1846b39c5158Smillert
1847b39c5158SmillertB<NOTE>  This behavior may go away in future versions.
1848b39c5158Smillert
1849b39c5158Smillert
1850e5157e49Safresh1=head1 COMPATIBILITY
1851e5157e49Safresh1
1852e5157e49Safresh1Test::More works with Perls as old as 5.8.1.
1853e5157e49Safresh1
1854e5157e49Safresh1Thread support is not very reliable before 5.10.1, but that's
1855e5157e49Safresh1because threads are not very reliable before 5.10.1.
1856e5157e49Safresh1
1857e5157e49Safresh1Although 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.
1858e5157e49Safresh1
1859e5157e49Safresh1Key feature milestones include:
1860b39c5158Smillert
1861b39c5158Smillert=over 4
1862b39c5158Smillert
1863e5157e49Safresh1=item subtests
1864b39c5158Smillert
1865e5157e49Safresh1Subtests 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.
1866b39c5158Smillert
1867e5157e49Safresh1=item C<done_testing()>
1868e5157e49Safresh1
1869e5157e49Safresh1This was released in Test::More 0.88 and first shipped with Perl in 5.10.1 as part of Test::More 0.92.
1870e5157e49Safresh1
1871e5157e49Safresh1=item C<cmp_ok()>
1872e5157e49Safresh1
1873e5157e49Safresh1Although 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.
1874e5157e49Safresh1
1875e5157e49Safresh1=item C<new_ok()> C<note()> and C<explain()>
1876e5157e49Safresh1
1877e5157e49Safresh1These were was released in Test::More 0.82, and first shipped with Perl in 5.10.1 as part of Test::More 0.92.
1878e5157e49Safresh1
1879e5157e49Safresh1=back
1880e5157e49Safresh1
1881e5157e49Safresh1There is a full version history in the Changes file, and the Test::More versions included as core can be found using L<Module::CoreList>:
1882e5157e49Safresh1
1883e5157e49Safresh1    $ corelist -a Test::More
1884e5157e49Safresh1
1885e5157e49Safresh1
1886e5157e49Safresh1=head1 CAVEATS and NOTES
1887e5157e49Safresh1
1888e5157e49Safresh1=over 4
1889b39c5158Smillert
1890b39c5158Smillert=item utf8 / "Wide character in print"
1891b39c5158Smillert
1892b39c5158SmillertIf you use utf8 or other non-ASCII characters with Test::More you
1893b8851fccSafresh1might get a "Wide character in print" warning.  Using
1894b8851fccSafresh1C<< binmode STDOUT, ":utf8" >> will not fix it.
1895b8851fccSafresh1L<Test::Builder> (which powers
1896b39c5158SmillertTest::More) duplicates STDOUT and STDERR.  So any changes to them,
189756d68f1eSafresh1including changing their output disciplines, will not be seen by
1898b39c5158SmillertTest::More.
1899b39c5158Smillert
1900e5157e49Safresh1One work around is to apply encodings to STDOUT and STDERR as early
1901e5157e49Safresh1as possible and before Test::More (or any other Test module) loads.
1902e5157e49Safresh1
1903e5157e49Safresh1    use open ':std', ':encoding(utf8)';
1904e5157e49Safresh1    use Test::More;
1905e5157e49Safresh1
1906e5157e49Safresh1A more direct work around is to change the filehandles used by
1907b8851fccSafresh1L<Test::Builder>.
1908b39c5158Smillert
1909b39c5158Smillert    my $builder = Test::More->builder;
1910e5157e49Safresh1    binmode $builder->output,         ":encoding(utf8)";
1911e5157e49Safresh1    binmode $builder->failure_output, ":encoding(utf8)";
1912e5157e49Safresh1    binmode $builder->todo_output,    ":encoding(utf8)";
1913b39c5158Smillert
1914b39c5158Smillert
1915b39c5158Smillert=item Overloaded objects
1916b39c5158Smillert
1917b8851fccSafresh1String overloaded objects are compared B<as strings> (or in C<cmp_ok()>'s
1918b39c5158Smillertcase, strings or numbers as appropriate to the comparison op).  This
1919b39c5158Smillertprevents Test::More from piercing an object's interface allowing
1920b39c5158Smillertbetter blackbox testing.  So if a function starts returning overloaded
1921b39c5158Smillertobjects instead of bare strings your tests won't notice the
1922b39c5158Smillertdifference.  This is good.
1923b39c5158Smillert
1924b8851fccSafresh1However, it does mean that functions like C<is_deeply()> cannot be used to
1925b39c5158Smillerttest the internals of string overloaded objects.  In this case I would
1926b39c5158Smillertsuggest L<Test::Deep> which contains more flexible testing functions for
1927b39c5158Smillertcomplex data structures.
1928b39c5158Smillert
1929b39c5158Smillert
1930b39c5158Smillert=item Threads
1931b39c5158Smillert
1932b8851fccSafresh1Test::More will only be aware of threads if C<use threads> has been done
1933b39c5158SmillertI<before> Test::More is loaded.  This is ok:
1934b39c5158Smillert
1935b39c5158Smillert    use threads;
1936b39c5158Smillert    use Test::More;
1937b39c5158Smillert
1938b39c5158SmillertThis may cause problems:
1939b39c5158Smillert
1940b39c5158Smillert    use Test::More
1941b39c5158Smillert    use threads;
1942b39c5158Smillert
1943b39c5158Smillert5.8.1 and above are supported.  Anything below that has too many bugs.
1944b39c5158Smillert
1945b39c5158Smillert=back
1946b39c5158Smillert
1947b39c5158Smillert
1948b39c5158Smillert=head1 HISTORY
1949b39c5158Smillert
1950b8851fccSafresh1This is a case of convergent evolution with Joshua Pritikin's L<Test>
1951b39c5158Smillertmodule.  I was largely unaware of its existence when I'd first
1952b8851fccSafresh1written my own C<ok()> routines.  This module exists because I can't
1953b39c5158Smillertfigure out how to easily wedge test names into Test's interface (along
1954b39c5158Smillertwith a few other problems).
1955b39c5158Smillert
1956b39c5158SmillertThe goal here is to have a testing utility that's simple to learn,
1957b39c5158Smillertquick to use and difficult to trip yourself up with while still
1958b39c5158Smillertproviding more flexibility than the existing Test.pm.  As such, the
1959b39c5158Smillertnames of the most common routines are kept tiny, special cases and
1960b39c5158Smillertmagic side-effects are kept to a minimum.  WYSIWYG.
1961b39c5158Smillert
1962b39c5158Smillert
1963b39c5158Smillert=head1 SEE ALSO
1964b39c5158Smillert
1965b8851fccSafresh1=head2
1966b8851fccSafresh1
1967b8851fccSafresh1=head2 ALTERNATIVES
1968b8851fccSafresh1
1969b46d8ef2Safresh1L<Test2::Suite> is the most recent and modern set of tools for testing.
1970b46d8ef2Safresh1
1971b39c5158SmillertL<Test::Simple> if all this confuses you and you just want to write
1972b39c5158Smillertsome tests.  You can upgrade to Test::More later (it's forward
1973b39c5158Smillertcompatible).
1974b39c5158Smillert
1975b39c5158SmillertL<Test::Legacy> tests written with Test.pm, the original testing
1976b39c5158Smillertmodule, do not play well with other testing libraries.  Test::Legacy
1977b39c5158Smillertemulates the Test.pm interface and does play well with others.
1978b39c5158Smillert
1979b8851fccSafresh1=head2 ADDITIONAL LIBRARIES
1980b8851fccSafresh1
1981b39c5158SmillertL<Test::Differences> for more ways to test complex data structures.
1982b39c5158SmillertAnd it plays well with Test::More.
1983b39c5158Smillert
1984b39c5158SmillertL<Test::Class> is like xUnit but more perlish.
1985b39c5158Smillert
1986b39c5158SmillertL<Test::Deep> gives you more powerful complex data structure testing.
1987b39c5158Smillert
1988b39c5158SmillertL<Test::Inline> shows the idea of embedded testing.
1989b39c5158Smillert
1990b8851fccSafresh1L<Mock::Quick> The ultimate mocking library. Easily spawn objects defined on
1991b8851fccSafresh1the fly. Can also override, block, or reimplement packages as needed.
1992b8851fccSafresh1
1993b8851fccSafresh1L<Test::FixtureBuilder> Quickly define fixture data for unit tests.
1994b8851fccSafresh1
1995b8851fccSafresh1=head2 OTHER COMPONENTS
1996b8851fccSafresh1
1997b8851fccSafresh1L<Test::Harness> is the test runner and output interpreter for Perl.
1998b8851fccSafresh1It's the thing that powers C<make test> and where the C<prove> utility
1999b8851fccSafresh1comes from.
2000b8851fccSafresh1
2001b8851fccSafresh1=head2 BUNDLES
2002b8851fccSafresh1
2003b8851fccSafresh1L<Test::Most> Most commonly needed test functions and features.
2004b39c5158Smillert
2005b39c5158Smillert=head1 AUTHORS
2006b39c5158Smillert
2007b39c5158SmillertMichael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
2008b39c5158Smillertfrom Joshua Pritikin's Test module and lots of help from Barrie
2009b39c5158SmillertSlaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and
2010b39c5158Smillertthe perl-qa gang.
2011b39c5158Smillert
2012b8851fccSafresh1=head1 MAINTAINERS
2013b8851fccSafresh1
2014b8851fccSafresh1=over 4
2015b8851fccSafresh1
2016b8851fccSafresh1=item Chad Granum E<lt>exodist@cpan.orgE<gt>
2017b8851fccSafresh1
2018b8851fccSafresh1=back
2019b8851fccSafresh1
2020b39c5158Smillert
2021b39c5158Smillert=head1 BUGS
2022b39c5158Smillert
2023*3d61058aSafresh1See L<https://github.com/Test-More/test-more/issues> to report and view bugs.
2024b39c5158Smillert
2025b39c5158Smillert
2026b39c5158Smillert=head1 SOURCE
2027b39c5158Smillert
2028b39c5158SmillertThe source code repository for Test::More can be found at
2029*3d61058aSafresh1L<https://github.com/Test-More/test-more/>.
2030b39c5158Smillert
2031b39c5158Smillert
2032b39c5158Smillert=head1 COPYRIGHT
2033b39c5158Smillert
2034b39c5158SmillertCopyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
2035b39c5158Smillert
2036b39c5158SmillertThis program is free software; you can redistribute it and/or
2037b39c5158Smillertmodify it under the same terms as Perl itself.
2038b39c5158Smillert
2039*3d61058aSafresh1See L<https://dev.perl.org/licenses/>
2040b39c5158Smillert
2041b39c5158Smillert=cut
2042b39c5158Smillert
2043b39c5158Smillert1;
2044