This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
617455fe1afbdfb2f895860173e7a19f18fb66ee
[perl5.git] / lib / Test / More.pm
1 package Test::More;
2
3 use 5.004;
4
5 use strict;
6 use Test::Builder;
7
8
9 # Can't use Carp because it might cause use_ok() to accidentally succeed
10 # even though the module being used forgot to use Carp.  Yes, this
11 # actually happened.
12 sub _carp {
13     my($file, $line) = (caller(1))[1,2];
14     warn @_, sprintf " at $file line $line\n";
15 }
16
17
18
19 require Exporter;
20 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
21 $VERSION = '0.33';
22 @ISA    = qw(Exporter);
23 @EXPORT = qw(ok use_ok require_ok
24              is isnt like is_deeply
25              skip todo
26              pass fail
27              eq_array eq_hash eq_set
28              $TODO
29              plan
30              can_ok  isa_ok
31             );
32
33 my $Test = Test::Builder->new;
34
35
36 # 5.004's Exporter doesn't have export_to_level.
37 sub _export_to_level
38 {
39       my $pkg = shift;
40       my $level = shift;
41       (undef) = shift;                  # XXX redundant arg
42       my $callpkg = caller($level);
43       $pkg->export($callpkg, @_);
44 }
45
46
47 =head1 NAME
48
49 Test::More - yet another framework for writing test scripts
50
51 =head1 SYNOPSIS
52
53   use Test::More tests => $Num_Tests;
54   # or
55   use Test::More qw(no_plan);
56   # or
57   use Test::More skip_all => $reason;
58
59   BEGIN { use_ok( 'Some::Module' ); }
60   require_ok( 'Some::Module' );
61
62   # Various ways to say "ok"
63   ok($this eq $that, $test_name);
64
65   is  ($this, $that,    $test_name);
66   isnt($this, $that,    $test_name);
67   like($this, qr/that/, $test_name);
68
69   is_deeply($complex_structure1, $complex_structure2, $test_name);
70
71   SKIP: {
72       skip $why, $how_many unless $have_some_feature;
73
74       ok( foo(),       $test_name );
75       is( foo(42), 23, $test_name );
76   };
77
78   TODO: {
79       local $TODO = $why;
80
81       ok( foo(),       $test_name );
82       is( foo(42), 23, $test_name );
83   };
84
85   can_ok($module, @methods);
86   isa_ok($object, $class);
87
88   pass($test_name);
89   fail($test_name);
90
91   # Utility comparison functions.
92   eq_array(\@this, \@that);
93   eq_hash(\%this, \%that);
94   eq_set(\@this, \@that);
95
96   # UNIMPLEMENTED!!!
97   my @status = Test::More::status;
98
99   # UNIMPLEMENTED!!!
100   BAIL_OUT($why);
101
102
103 =head1 DESCRIPTION
104
105 If you're just getting started writing tests, have a look at
106 Test::Simple first.  This is a drop in replacement for Test::Simple
107 which you can switch to once you get the hang of basic testing.
108
109 This module provides a very wide range of testing utilities.  Various
110 ways to say "ok", facilities to skip tests, test future features
111 and compare complicated data structures.
112
113
114 =head2 I love it when a plan comes together
115
116 Before anything else, you need a testing plan.  This basically declares
117 how many tests your script is going to run to protect against premature
118 failure.
119
120 The preferred way to do this is to declare a plan when you C<use Test::More>.
121
122   use Test::More tests => $Num_Tests;
123
124 There are rare cases when you will not know beforehand how many tests
125 your script is going to run.  In this case, you can declare that you
126 have no plan.  (Try to avoid using this as it weakens your test.)
127
128   use Test::More qw(no_plan);
129
130 In some cases, you'll want to completely skip an entire testing script.
131
132   use Test::More skip_all => $skip_reason;
133
134 Your script will declare a skip with the reason why you skipped and
135 exit immediately with a zero (success).  See L<Test::Harness> for
136 details.
137
138 If you want to control what functions Test::More will export, you
139 have to use the 'import' option.  For example, to import everything
140 but 'fail', you'd do:
141
142   use Test::More tests => 23, import => ['!fail'];
143
144 Alternatively, you can use the plan() function.  Useful for when you
145 have to calculate the number of tests.
146
147   use Test::More;
148   plan tests => keys %Stuff * 3;
149
150 or for deciding between running the tests at all:
151
152   use Test::More;
153   if( $^O eq 'MacOS' ) {
154       plan skip_all => 'Test irrelevant on MacOS';
155   }
156   else {
157       plan tests => 42;
158   }
159
160 =cut
161
162 sub plan {
163     my(@plan) = @_;
164
165     my $caller = caller;
166
167     $Test->exported_to($caller);
168     $Test->plan(@plan);
169
170     my @imports = ();
171     foreach my $idx (0..$#plan) {
172         if( $plan[$idx] eq 'import' ) {
173             @imports = @{$plan[$idx+1]};
174             last;
175         }
176     }
177
178     __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
179 }
180
181 sub import {
182     my($class) = shift;
183     goto &plan;
184 }
185
186
187 =head2 Test names
188
189 By convention, each test is assigned a number in order.  This is
190 largely done automatically for you.  However, its often very useful to
191 assign a name to each test.  Which would you rather see:
192
193   ok 4
194   not ok 5
195   ok 6
196
197 or
198
199   ok 4 - basic multi-variable
200   not ok 5 - simple exponential
201   ok 6 - force == mass * acceleration
202
203 The later gives you some idea of what failed.  It also makes it easier
204 to find the test in your script, simply search for "simple
205 exponential".
206
207 All test functions take a name argument.  Its optional, but highly
208 suggested that you use it.
209
210
211 =head2 I'm ok, you're not ok.
212
213 The basic purpose of this module is to print out either "ok #" or "not
214 ok #" depending on if a given test succeeded or failed.  Everything
215 else is just gravy.
216
217 All of the following print "ok" or "not ok" depending on if the test
218 succeeded or failed.  They all also return true or false,
219 respectively.
220
221 =over 4
222
223 =item B<ok>
224
225   ok($this eq $that, $test_name);
226
227 This simply evaluates any expression (C<$this eq $that> is just a
228 simple example) and uses that to determine if the test succeeded or
229 failed.  A true expression passes, a false one fails.  Very simple.
230
231 For example:
232
233     ok( $exp{9} == 81,                   'simple exponential' );
234     ok( Film->can('db_Main'),            'set_db()' );
235     ok( $p->tests == 4,                  'saw tests' );
236     ok( !grep !defined $_, @items,       'items populated' );
237
238 (Mnemonic:  "This is ok.")
239
240 $test_name is a very short description of the test that will be printed
241 out.  It makes it very easy to find a test in your script when it fails
242 and gives others an idea of your intentions.  $test_name is optional,
243 but we B<very> strongly encourage its use.
244
245 Should an ok() fail, it will produce some diagnostics:
246
247     not ok 18 - sufficient mucus
248     #     Failed test 18 (foo.t at line 42)
249
250 This is actually Test::Simple's ok() routine.
251
252 =cut
253
254 sub ok ($;$) {
255     my($test, $name) = @_;
256     $Test->ok($test, $name);
257 }
258
259 =item B<is>
260
261 =item B<isnt>
262
263   is  ( $this, $that, $test_name );
264   isnt( $this, $that, $test_name );
265
266 Similar to ok(), is() and isnt() compare their two arguments
267 with C<eq> and C<ne> respectively and use the result of that to
268 determine if the test succeeded or failed.  So these:
269
270     # Is the ultimate answer 42?
271     is( ultimate_answer(), 42,          "Meaning of Life" );
272
273     # $foo isn't empty
274     isnt( $foo, '',     "Got some foo" );
275
276 are similar to these:
277
278     ok( ultimate_answer() eq 42,        "Meaning of Life" );
279     ok( $foo ne '',     "Got some foo" );
280
281 (Mnemonic:  "This is that."  "This isn't that.")
282
283 So why use these?  They produce better diagnostics on failure.  ok()
284 cannot know what you are testing for (beyond the name), but is() and
285 isnt() know what the test was and why it failed.  For example this
286 test:
287
288     my $foo = 'waffle';  my $bar = 'yarblokos';
289     is( $foo, $bar,   'Is foo the same as bar?' );
290
291 Will produce something like this:
292
293     not ok 17 - Is foo the same as bar?
294     #     Failed test 1 (foo.t at line 139)
295     #          got: 'waffle'
296     #     expected: 'yarblokos'
297
298 So you can figure out what went wrong without rerunning the test.
299
300 You are encouraged to use is() and isnt() over ok() where possible,
301 however do not be tempted to use them to find out if something is
302 true or false!
303
304   # XXX BAD!  $pope->isa('Catholic') eq 1
305   is( $pope->isa('Catholic'), 1,        'Is the Pope Catholic?' );
306
307 This does not check if C<$pope->isa('Catholic')> is true, it checks if
308 it returns 1.  Very different.  Similar caveats exist for false and 0.
309 In these cases, use ok().
310
311   ok( $pope->isa('Catholic') ),         'Is the Pope Catholic?' );
312
313 For those grammatical pedants out there, there's an C<isn't()>
314 function which is an alias of isnt().
315
316 =cut
317
318 sub is ($$;$) {
319     $Test->is_eq(@_);
320 }
321
322 sub isnt ($$;$) {
323     my($this, $that, $name) = @_;
324
325     my $test;
326     {
327         local $^W = 0;   # so isnt(undef, undef) works quietly.
328         $test = $this ne $that;
329     }
330
331     my $ok = $Test->ok($test, $name);
332
333     unless( $ok ) {
334         $that = defined $that ? "'$that'" : 'undef';
335
336         $Test->diag(sprintf <<DIAGNOSTIC, $that);
337 it should not be %s
338 but it is.
339 DIAGNOSTIC
340
341     }
342
343     return $ok;
344 }
345
346 *isn't = \&isnt;
347
348
349 =item B<like>
350
351   like( $this, qr/that/, $test_name );
352
353 Similar to ok(), like() matches $this against the regex C<qr/that/>.
354
355 So this:
356
357     like($this, qr/that/, 'this is like that');
358
359 is similar to:
360
361     ok( $this =~ /that/, 'this is like that');
362
363 (Mnemonic "This is like that".)
364
365 The second argument is a regular expression.  It may be given as a
366 regex reference (i.e. C<qr//>) or (for better compatibility with older
367 perls) as a string that looks like a regex (alternative delimiters are
368 currently not supported):
369
370     like( $this, '/that/', 'this is like that' );
371
372 Regex options may be placed on the end (C<'/that/i'>).
373
374 Its advantages over ok() are similar to that of is() and isnt().  Better
375 diagnostics on failure.
376
377 =cut
378
379 sub like ($$;$) {
380     $Test->like(@_);
381 }
382
383 =item B<can_ok>
384
385   can_ok($module, @methods);
386   can_ok($object, @methods);
387
388 Checks to make sure the $module or $object can do these @methods
389 (works with functions, too).
390
391     can_ok('Foo', qw(this that whatever));
392
393 is almost exactly like saying:
394
395     ok( Foo->can('this') && 
396         Foo->can('that') && 
397         Foo->can('whatever') 
398       );
399
400 only without all the typing and with a better interface.  Handy for
401 quickly testing an interface.
402
403 =cut
404
405 sub can_ok ($@) {
406     my($proto, @methods) = @_;
407     my $class= ref $proto || $proto;
408
409     my @nok = ();
410     foreach my $method (@methods) {
411         my $test = "'$class'->can('$method')";
412         eval $test || push @nok, $method;
413     }
414
415     my $name;
416     $name = @methods == 1 ? "$class->can($methods[0])" 
417                           : "$class->can(...)";
418     
419     my $ok = $Test->ok( !@nok, $name );
420
421     $Test->diag(map "$class->can('$_') failed\n", @nok);
422
423     return $ok;
424 }
425
426 =item B<isa_ok>
427
428   isa_ok($object, $class, $object_name);
429
430 Checks to see if the given $object->isa($class).  Also checks to make
431 sure the object was defined in the first place.  Handy for this sort
432 of thing:
433
434     my $obj = Some::Module->new;
435     isa_ok( $obj, 'Some::Module' );
436
437 where you'd otherwise have to write
438
439     my $obj = Some::Module->new;
440     ok( defined $obj && $obj->isa('Some::Module') );
441
442 to safeguard against your test script blowing up.
443
444 The diagnostics of this test normally just refer to 'the object'.  If
445 you'd like them to be more specific, you can supply an $object_name
446 (for example 'Test customer').
447
448 =cut
449
450 sub isa_ok ($$;$) {
451     my($object, $class, $obj_name) = @_;
452
453     my $diag;
454     $obj_name = 'The object' unless defined $obj_name;
455     my $name = "$obj_name isa $class";
456     if( !defined $object ) {
457         $diag = "$obj_name isn't defined";
458     }
459     elsif( !ref $object ) {
460         $diag = "$obj_name isn't a reference";
461     }
462     elsif( !$object->isa($class) ) {
463         $diag = "$obj_name isn't a '$class'";
464     }
465
466     my $ok;
467     if( $diag ) {
468         $ok = $Test->ok( 0, $name );
469         $Test->diag("$diag\n");
470     }
471     else {
472         $ok = $Test->ok( 1, $name );
473     }
474
475     return $ok;
476 }
477
478
479 =item B<pass>
480
481 =item B<fail>
482
483   pass($test_name);
484   fail($test_name);
485
486 Sometimes you just want to say that the tests have passed.  Usually
487 the case is you've got some complicated condition that is difficult to
488 wedge into an ok().  In this case, you can simply use pass() (to
489 declare the test ok) or fail (for not ok).  They are synonyms for
490 ok(1) and ok(0).
491
492 Use these very, very, very sparingly.
493
494 =cut
495
496 sub pass (;$) {
497     $Test->ok(1, @_);
498 }
499
500 sub fail (;$) {
501     $Test->ok(0, @_);
502 }
503
504 =back
505
506 =head2 Module tests
507
508 You usually want to test if the module you're testing loads ok, rather
509 than just vomiting if its load fails.  For such purposes we have
510 C<use_ok> and C<require_ok>.
511
512 =over 4
513
514 =item B<use_ok>
515
516    BEGIN { use_ok($module); }
517    BEGIN { use_ok($module, @imports); }
518
519 These simply use the given $module and test to make sure the load
520 happened ok.  Its recommended that you run use_ok() inside a BEGIN
521 block so its functions are exported at compile-time and prototypes are
522 properly honored.
523
524 If @imports are given, they are passed through to the use.  So this:
525
526    BEGIN { use_ok('Some::Module', qw(foo bar)) }
527
528 is like doing this:
529
530    use Some::Module qw(foo bar);
531
532
533 =cut
534
535 sub use_ok ($;@) {
536     my($module, @imports) = @_;
537     @imports = () unless @imports;
538
539     my $pack = caller;
540
541     eval <<USE;
542 package $pack;
543 require $module;
544 $module->import(\@imports);
545 USE
546
547     my $ok = $Test->ok( !$@, "use $module;" );
548
549     unless( $ok ) {
550         chomp $@;
551         $Test->diag(<<DIAGNOSTIC);
552 Tried to use '$module'.
553 Error:  $@
554 DIAGNOSTIC
555
556     }
557
558     return $ok;
559 }
560
561 =item B<require_ok>
562
563    require_ok($module);
564
565 Like use_ok(), except it requires the $module.
566
567 =cut
568
569 sub require_ok ($) {
570     my($module) = shift;
571
572     my $pack = caller;
573
574     eval <<REQUIRE;
575 package $pack;
576 require $module;
577 REQUIRE
578
579     my $ok = $Test->ok( !$@, "require $module;" );
580
581     unless( $ok ) {
582         chomp $@;
583         $Test->diag(<<DIAGNOSTIC);
584 #     Tried to require '$module'.
585 #     Error:  $@
586 DIAGNOSTIC
587
588     }
589
590     return $ok;
591 }
592
593 =back
594
595 =head2 Conditional tests
596
597 B<WARNING!> The following describes an I<experimental> interface that
598 is subject to change B<WITHOUT NOTICE>!  Use at your peril.
599
600 Sometimes running a test under certain conditions will cause the
601 test script to die.  A certain function or method isn't implemented
602 (such as fork() on MacOS), some resource isn't available (like a 
603 net connection) or a module isn't available.  In these cases it's
604 necessary to skip tests, or declare that they are supposed to fail
605 but will work in the future (a todo test).
606
607 For more details on skip and todo tests see L<Test::Harness>.
608
609 The way Test::More handles this is with a named block.  Basically, a
610 block of tests which can be skipped over or made todo.  It's best if I
611 just show you...
612
613 =over 4
614
615 =item B<SKIP: BLOCK>
616
617   SKIP: {
618       skip $why, $how_many if $condition;
619
620       ...normal testing code goes here...
621   }
622
623 This declares a block of tests to skip, $how_many tests there are,
624 $why and under what $condition to skip them.  An example is the
625 easiest way to illustrate:
626
627     SKIP: {
628         skip "Pigs don't fly here", 2 unless Pigs->can('fly');
629
630         my $pig = Pigs->new;
631         $pig->takeoff;
632
633         ok( $pig->altitude > 0,         'Pig is airborne' );
634         ok( $pig->airspeed > 0,         '  and moving'    );
635     }
636
637 If pigs cannot fly, the whole block of tests will be skipped
638 completely.  Test::More will output special ok's which Test::Harness
639 interprets as skipped tests.  Its important to include $how_many tests
640 are in the block so the total number of tests comes out right (unless
641 you're using C<no_plan>, in which case you can leave $how_many off if
642 you like).
643
644 You'll typically use this when a feature is missing, like an optional
645 module is not installed or the operating system doesn't have some
646 feature (like fork() or symlinks) or maybe you need an Internet
647 connection and one isn't available.
648
649 =for _Future
650 See L</Why are skip and todo so weird?>
651
652 =cut
653
654 #'#
655 sub skip {
656     my($why, $how_many) = @_;
657
658     unless( defined $how_many ) {
659         # $how_many can only be avoided when no_plan is in use.
660         _carp "skip() needs to know \$how_many tests are in the block"
661           unless $Test::Builder::No_Plan;
662         $how_many = 1;
663     }
664
665     for( 1..$how_many ) {
666         $Test->skip($why);
667     }
668
669     local $^W = 0;
670     last SKIP;
671 }
672
673
674 =item B<TODO: BLOCK>
675
676     TODO: {
677         local $TODO = $why;
678
679         ...normal testing code goes here...
680     }
681
682 Declares a block of tests you expect to fail and $why.  Perhaps it's
683 because you haven't fixed a bug or haven't finished a new feature:
684
685     TODO: {
686         local $TODO = "URI::Geller not finished";
687
688         my $card = "Eight of clubs";
689         is( URI::Geller->your_card, $card, 'Is THIS your card?' );
690
691         my $spoon;
692         URI::Geller->bend_spoon;
693         is( $spoon, 'bent',    "Spoon bending, that's original" );
694     }
695
696 With a todo block, the tests inside are expected to fail.  Test::More
697 will run the tests normally, but print out special flags indicating
698 they are "todo".  Test::Harness will interpret failures as being ok.
699 Should anything succeed, it will report it as an unexpected success.
700
701 The nice part about todo tests, as opposed to simply commenting out a
702 block of tests, is it's like having a programmatic todo list.  You know
703 how much work is left to be done, you're aware of what bugs there are,
704 and you'll know immediately when they're fixed.
705
706 Once a todo test starts succeeding, simply move it outside the block.
707 When the block is empty, delete it.
708
709
710 =back
711
712 =head2 Comparison functions
713
714 Not everything is a simple eq check or regex.  There are times you
715 need to see if two arrays are equivalent, for instance.  For these
716 instances, Test::More provides a handful of useful functions.
717
718 B<NOTE> These are NOT well-tested on circular references.  Nor am I
719 quite sure what will happen with filehandles.
720
721 =over 4
722
723 =item B<is_deeply>
724
725   is_deeply( $this, $that, $test_name );
726
727 Similar to is(), except that if $this and $that are hash or array
728 references, it does a deep comparison walking each data structure to
729 see if they are equivalent.  If the two structures are different, it
730 will display the place where they start differing.
731
732 B<NOTE> Display of scalar refs is not quite 100%
733
734 =cut
735
736 use vars qw(@Data_Stack);
737 my $DNE = bless [], 'Does::Not::Exist';
738 sub is_deeply {
739     my($this, $that, $name) = @_;
740
741     my $ok;
742     if( !ref $this || !ref $that ) {
743         $ok = $Test->is_eq($this, $that, $name);
744     }
745     else {
746         local @Data_Stack = ();
747         if( _deep_check($this, $that) ) {
748             $ok = $Test->ok(1, $name);
749         }
750         else {
751             $ok = $Test->ok(0, $name);
752             $ok = $Test->diag(_format_stack(@Data_Stack));
753         }
754     }
755
756     return $ok;
757 }
758
759 sub _format_stack {
760     my(@Stack) = @_;
761
762     my $var = '$FOO';
763     my $did_arrow = 0;
764     foreach my $entry (@Stack) {
765         my $type = $entry->{type} || '';
766         my $idx  = $entry->{'idx'};
767         if( $type eq 'HASH' ) {
768             $var .= "->" unless $did_arrow++;
769             $var .= "{$idx}";
770         }
771         elsif( $type eq 'ARRAY' ) {
772             $var .= "->" unless $did_arrow++;
773             $var .= "[$idx]";
774         }
775         elsif( $type eq 'REF' ) {
776             $var = "\${$var}";
777         }
778     }
779
780     my @vals = @{$Stack[-1]{vals}}[0,1];
781     my @vars = ();
782     ($vars[0] = $var) =~ s/\$FOO/     \$got/;
783     ($vars[1] = $var) =~ s/\$FOO/\$expected/;
784
785     my $out = "Structures begin differing at:\n";
786     foreach my $idx (0..$#vals) {
787         my $val = $vals[$idx];
788         $vals[$idx] = !defined $val ? 'undef' : 
789                       $val eq $DNE  ? "Does not exist"
790                                     : "'$val'";
791     }
792
793     $out .= "$vars[0] = $vals[0]\n";
794     $out .= "$vars[1] = $vals[1]\n";
795
796     return $out;
797 }
798
799
800 =item B<eq_array>
801
802   eq_array(\@this, \@that);
803
804 Checks if two arrays are equivalent.  This is a deep check, so
805 multi-level structures are handled correctly.
806
807 =cut
808
809 #'#
810 sub eq_array  {
811     my($a1, $a2) = @_;
812     return 1 if $a1 eq $a2;
813
814     my $ok = 1;
815     my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
816     for (0..$max) {
817         my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
818         my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
819
820         push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
821         $ok = _deep_check($e1,$e2);
822         pop @Data_Stack if $ok;
823
824         last unless $ok;
825     }
826     return $ok;
827 }
828
829 sub _deep_check {
830     my($e1, $e2) = @_;
831     my $ok = 0;
832
833     my $eq;
834     {
835         # Quiet uninitialized value warnings when comparing undefs.
836         local $^W = 0; 
837
838         if( $e1 eq $e2 ) {
839             $ok = 1;
840         }
841         else {
842             if( UNIVERSAL::isa($e1, 'ARRAY') and
843                 UNIVERSAL::isa($e2, 'ARRAY') )
844             {
845                 $ok = eq_array($e1, $e2);
846             }
847             elsif( UNIVERSAL::isa($e1, 'HASH') and
848                    UNIVERSAL::isa($e2, 'HASH') )
849             {
850                 $ok = eq_hash($e1, $e2);
851             }
852             elsif( UNIVERSAL::isa($e1, 'REF') and
853                    UNIVERSAL::isa($e2, 'REF') )
854             {
855                 push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
856                 $ok = _deep_check($$e1, $$e2);
857                 pop @Data_Stack if $ok;
858             }
859             elsif( UNIVERSAL::isa($e1, 'SCALAR') and
860                    UNIVERSAL::isa($e2, 'SCALAR') )
861             {
862                 push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
863                 $ok = _deep_check($$e1, $$e2);
864             }
865             else {
866                 push @Data_Stack, { vals => [$e1, $e2] };
867                 $ok = 0;
868             }
869         }
870     }
871
872     return $ok;
873 }
874
875
876 =item B<eq_hash>
877
878   eq_hash(\%this, \%that);
879
880 Determines if the two hashes contain the same keys and values.  This
881 is a deep check.
882
883 =cut
884
885 sub eq_hash {
886     my($a1, $a2) = @_;
887     return 1 if $a1 eq $a2;
888
889     my $ok = 1;
890     my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
891     foreach my $k (keys %$bigger) {
892         my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
893         my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
894
895         push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
896         $ok = _deep_check($e1, $e2);
897         pop @Data_Stack if $ok;
898
899         last unless $ok;
900     }
901
902     return $ok;
903 }
904
905 =item B<eq_set>
906
907   eq_set(\@this, \@that);
908
909 Similar to eq_array(), except the order of the elements is B<not>
910 important.  This is a deep check, but the irrelevancy of order only
911 applies to the top level.
912
913 =cut
914
915 # We must make sure that references are treated neutrally.  It really
916 # doesn't matter how we sort them, as long as both arrays are sorted
917 # with the same algorithm.
918 sub _bogus_sort { local $^W = 0;  ref $a ? 0 : $a cmp $b }
919
920 sub eq_set  {
921     my($a1, $a2) = @_;
922     return 0 unless @$a1 == @$a2;
923
924     # There's faster ways to do this, but this is easiest.
925     return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
926 }
927
928
929 =back
930
931 =head1 NOTES
932
933 Test::More is B<explicitly> tested all the way back to perl 5.004.
934
935 =head1 BUGS and CAVEATS
936
937 =over 4
938
939 =item Making your own ok()
940
941 This will not do what you mean:
942
943     sub my_ok {
944         ok( @_ );
945     }
946
947     my_ok( 2 + 2 == 5, 'Basic addition' );
948
949 since ok() takes it's arguments as scalars, it will see the length of
950 @_ (2) and always pass the test.  You want to do this instead:
951
952     sub my_ok {
953         ok( $_[0], $_[1] );
954     }
955
956 The other functions act similarly.
957
958 =item The eq_* family have some caveats.
959
960 =item Test::Harness upgrades
961
962 no_plan and todo depend on new Test::Harness features and fixes.  If
963 you're going to distribute tests that use no_plan your end-users will
964 have to upgrade Test::Harness to the latest one on CPAN.
965
966 If you simply depend on Test::More, it's own dependencies will cause a
967 Test::Harness upgrade.
968
969 =back
970
971
972 =head1 HISTORY
973
974 This is a case of convergent evolution with Joshua Pritikin's Test
975 module.  I was largely unaware of its existence when I'd first
976 written my own ok() routines.  This module exists because I can't
977 figure out how to easily wedge test names into Test's interface (along
978 with a few other problems).
979
980 The goal here is to have a testing utility that's simple to learn,
981 quick to use and difficult to trip yourself up with while still
982 providing more flexibility than the existing Test.pm.  As such, the
983 names of the most common routines are kept tiny, special cases and
984 magic side-effects are kept to a minimum.  WYSIWYG.
985
986
987 =head1 SEE ALSO
988
989 L<Test::Simple> if all this confuses you and you just want to write
990 some tests.  You can upgrade to Test::More later (its forward
991 compatible).
992
993 L<Test> for a similar testing module.
994
995 L<Test::Harness> for details on how your test results are interpreted
996 by Perl.
997
998 L<Test::Unit> describes a very featureful unit testing interface.
999
1000 L<Test::Inline> shows the idea of embedded testing.
1001
1002 L<SelfTest> is another approach to embedded testing.
1003
1004
1005 =head1 AUTHORS
1006
1007 Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration from
1008 Joshua Pritikin's Test module and lots of discussion with Barrie
1009 Slaymaker and the perl-qa gang.
1010
1011
1012 =head1 COPYRIGHT
1013
1014 Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1015
1016 This program is free software; you can redistribute it and/or 
1017 modify it under the same terms as Perl itself.
1018
1019 See L<http://www.perl.com/perl/misc/Artistic.html>
1020
1021 =cut
1022
1023 1;