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