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