lib/Test/More.pm

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