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