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