8 #---- perlcritic exemptions. ----#
10 # We use a lot of subroutine prototypes
11 ## no critic (Subroutines::ProhibitSubroutinePrototypes)
13 # Can't use Carp because it might cause use_ok() to accidentally succeed
14 # even though the module being used forgot to use Carp. Yes, this
17 my( $file, $line ) = ( caller(1) )[ 1, 2 ];
18 return warn @_, " at $file line $line\n";
21 our $VERSION = '0.86';
22 $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
24 use Test::Builder::Module;
25 our @ISA = qw(Test::Builder::Module);
26 our @EXPORT = qw(ok use_ok require_ok
27 is isnt like unlike is_deeply
31 eq_array eq_hash eq_set
41 Test::More - yet another framework for writing test scripts
45 use Test::More tests => 23;
47 use Test::More qw(no_plan);
49 use Test::More skip_all => $reason;
51 BEGIN { use_ok( 'Some::Module' ); }
52 require_ok( 'Some::Module' );
54 # Various ways to say "ok"
55 ok($got eq $expected, $test_name);
57 is ($got, $expected, $test_name);
58 isnt($got, $expected, $test_name);
60 # Rather than print STDERR "# here's what went wrong\n"
61 diag("here's what went wrong");
63 like ($got, qr/expected/, $test_name);
64 unlike($got, qr/expected/, $test_name);
66 cmp_ok($got, '==', $expected, $test_name);
68 is_deeply($got_complex_structure, $expected_complex_structure, $test_name);
71 skip $why, $how_many unless $have_some_feature;
73 ok( foo(), $test_name );
74 is( foo(42), 23, $test_name );
80 ok( foo(), $test_name );
81 is( foo(42), 23, $test_name );
84 can_ok($module, @methods);
85 isa_ok($object, $class);
93 my @status = Test::More::status;
98 B<STOP!> If you're just getting started writing tests, have a look at
99 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.
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.
109 =head2 I love it when a plan comes together
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
115 The preferred way to do this is to declare a plan when you C<use Test::More>.
117 use Test::More tests => 23;
119 There are rare cases when you will not know beforehand how many tests
120 your script is going to run. In this case, you can declare that you
121 have no plan. (Try to avoid using this as it weakens your test.)
123 use Test::More qw(no_plan);
125 B<NOTE>: using no_plan requires a Test::Harness upgrade else it will
126 think everything has failed. See L<CAVEATS and NOTES>).
128 In some cases, you'll want to completely skip an entire testing script.
130 use Test::More skip_all => $skip_reason;
132 Your script will declare a skip with the reason why you skipped and
133 exit immediately with a zero (success). See L<Test::Harness> for
136 If you want to control what functions Test::More will export, you
137 have to use the 'import' option. For example, to import everything
138 but 'fail', you'd do:
140 use Test::More tests => 23, import => ['!fail'];
142 Alternatively, you can use the plan() function. Useful for when you
143 have to calculate the number of tests.
146 plan tests => keys %Stuff * 3;
148 or for deciding between running the tests at all:
151 if( $^O eq 'MacOS' ) {
152 plan skip_all => 'Test irrelevant on MacOS';
161 my $tb = Test::More->builder;
163 return $tb->plan(@_);
166 # This implements "use Test::More 'no_diag'" but the behavior is
174 while( $idx <= $#{$list} ) {
175 my $item = $list->[$idx];
177 if( defined $item and $item eq 'no_diag' ) {
178 $class->builder->no_diag(1);
194 By convention, each test is assigned a number in order. This is
195 largely done automatically for you. However, it's often very useful to
196 assign a name to each test. Which would you rather see:
204 ok 4 - basic multi-variable
205 not ok 5 - simple exponential
206 ok 6 - force == mass * acceleration
208 The later gives you some idea of what failed. It also makes it easier
209 to find the test in your script, simply search for "simple
212 All test functions take a name argument. It's optional, but highly
213 suggested that you use it.
216 =head2 I'm ok, you're not ok.
218 The basic purpose of this module is to print out either "ok #" or "not
219 ok #" depending on if a given test succeeded or failed. Everything
222 All of the following print "ok" or "not ok" depending on if the test
223 succeeded or failed. They all also return true or false,
230 ok($got eq $expected, $test_name);
232 This simply evaluates any expression (C<$got eq $expected> is just a
233 simple example) and uses that to determine if the test succeeded or
234 failed. A true expression passes, a false one fails. Very simple.
238 ok( $exp{9} == 81, 'simple exponential' );
239 ok( Film->can('db_Main'), 'set_db()' );
240 ok( $p->tests == 4, 'saw tests' );
241 ok( !grep !defined $_, @items, 'items populated' );
243 (Mnemonic: "This is ok.")
245 $test_name is a very short description of the test that will be printed
246 out. It makes it very easy to find a test in your script when it fails
247 and gives others an idea of your intentions. $test_name is optional,
248 but we B<very> strongly encourage its use.
250 Should an ok() fail, it will produce some diagnostics:
252 not ok 18 - sufficient mucus
253 # Failed test 'sufficient mucus'
254 # in foo.t at line 42.
256 This is the same as Test::Simple's ok() routine.
261 my( $test, $name ) = @_;
262 my $tb = Test::More->builder;
264 return $tb->ok( $test, $name );
271 is ( $got, $expected, $test_name );
272 isnt( $got, $expected, $test_name );
274 Similar to ok(), is() and isnt() compare their two arguments
275 with C<eq> and C<ne> respectively and use the result of that to
276 determine if the test succeeded or failed. So these:
278 # Is the ultimate answer 42?
279 is( ultimate_answer(), 42, "Meaning of Life" );
282 isnt( $foo, '', "Got some foo" );
284 are similar to these:
286 ok( ultimate_answer() eq 42, "Meaning of Life" );
287 ok( $foo ne '', "Got some foo" );
289 (Mnemonic: "This is that." "This isn't that.")
291 So why use these? They produce better diagnostics on failure. ok()
292 cannot know what you are testing for (beyond the name), but is() and
293 isnt() know what the test was and why it failed. For example this
296 my $foo = 'waffle'; my $bar = 'yarblokos';
297 is( $foo, $bar, 'Is foo the same as bar?' );
299 Will produce something like this:
301 not ok 17 - Is foo the same as bar?
302 # Failed test 'Is foo the same as bar?'
303 # in foo.t at line 139.
305 # expected: 'yarblokos'
307 So you can figure out what went wrong without rerunning the test.
309 You are encouraged to use is() and isnt() over ok() where possible,
310 however do not be tempted to use them to find out if something is
314 is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' );
316 This does not check if C<exists $brooklyn{tree}> is true, it checks if
317 it returns 1. Very different. Similar caveats exist for false and 0.
318 In these cases, use ok().
320 ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' );
322 For those grammatical pedants out there, there's an C<isn't()>
323 function which is an alias of isnt().
328 my $tb = Test::More->builder;
330 return $tb->is_eq(@_);
334 my $tb = Test::More->builder;
336 return $tb->isnt_eq(@_);
343 like( $got, qr/expected/, $test_name );
345 Similar to ok(), like() matches $got against the regex C<qr/expected/>.
349 like($got, qr/expected/, 'this is like that');
353 ok( $got =~ /expected/, 'this is like that');
355 (Mnemonic "This is like that".)
357 The second argument is a regular expression. It may be given as a
358 regex reference (i.e. C<qr//>) or (for better compatibility with older
359 perls) as a string that looks like a regex (alternative delimiters are
360 currently not supported):
362 like( $got, '/expected/', 'this is like that' );
364 Regex options may be placed on the end (C<'/expected/i'>).
366 Its advantages over ok() are similar to that of is() and isnt(). Better
367 diagnostics on failure.
372 my $tb = Test::More->builder;
374 return $tb->like(@_);
379 unlike( $got, qr/expected/, $test_name );
381 Works exactly as like(), only it checks if $got B<does not> match the
387 my $tb = Test::More->builder;
389 return $tb->unlike(@_);
394 cmp_ok( $got, $op, $expected, $test_name );
396 Halfway between ok() and is() lies cmp_ok(). This allows you to
397 compare two arguments using any binary perl operator.
399 # ok( $got eq $expected );
400 cmp_ok( $got, 'eq', $expected, 'this eq that' );
402 # ok( $got == $expected );
403 cmp_ok( $got, '==', $expected, 'this == that' );
405 # ok( $got && $expected );
406 cmp_ok( $got, '&&', $expected, 'this && that' );
409 Its advantage over ok() is when the test fails you'll know what $got
413 # Failed test in foo.t at line 12.
418 It's also useful in those cases where you are comparing numbers and
419 is()'s use of C<eq> will interfere:
421 cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
426 my $tb = Test::More->builder;
428 return $tb->cmp_ok(@_);
433 can_ok($module, @methods);
434 can_ok($object, @methods);
436 Checks to make sure the $module or $object can do these @methods
437 (works with functions, too).
439 can_ok('Foo', qw(this that whatever));
441 is almost exactly like saying:
443 ok( Foo->can('this') &&
448 only without all the typing and with a better interface. Handy for
449 quickly testing an interface.
451 No matter how many @methods you check, a single can_ok() call counts
452 as one test. If you desire otherwise, use:
454 foreach my $meth (@methods) {
455 can_ok('Foo', $meth);
461 my( $proto, @methods ) = @_;
462 my $class = ref $proto || $proto;
463 my $tb = Test::More->builder;
466 my $ok = $tb->ok( 0, "->can(...)" );
467 $tb->diag(' can_ok() called with empty class or reference');
472 my $ok = $tb->ok( 0, "$class->can(...)" );
473 $tb->diag(' can_ok() called with no methods');
478 foreach my $method (@methods) {
479 $tb->_try( sub { $proto->can($method) } ) or push @nok, $method;
482 my $name = (@methods == 1) ? "$class->can('$methods[0]')" :
485 my $ok = $tb->ok( !@nok, $name );
487 $tb->diag( map " $class->can('$_') failed\n", @nok );
494 isa_ok($object, $class, $object_name);
495 isa_ok($ref, $type, $ref_name);
497 Checks to see if the given C<< $object->isa($class) >>. Also checks to make
498 sure the object was defined in the first place. Handy for this sort
501 my $obj = Some::Module->new;
502 isa_ok( $obj, 'Some::Module' );
504 where you'd otherwise have to write
506 my $obj = Some::Module->new;
507 ok( defined $obj && $obj->isa('Some::Module') );
509 to safeguard against your test script blowing up.
511 It works on references, too:
513 isa_ok( $array_ref, 'ARRAY' );
515 The diagnostics of this test normally just refer to 'the object'. If
516 you'd like them to be more specific, you can supply an $object_name
517 (for example 'Test customer').
522 my( $object, $class, $obj_name ) = @_;
523 my $tb = Test::More->builder;
526 $obj_name = 'The object' unless defined $obj_name;
527 my $name = "$obj_name isa $class";
528 if( !defined $object ) {
529 $diag = "$obj_name isn't defined";
531 elsif( !ref $object ) {
532 $diag = "$obj_name isn't a reference";
535 # We can't use UNIVERSAL::isa because we want to honor isa() overrides
536 my( $rslt, $error ) = $tb->_try( sub { $object->isa($class) } );
538 if( $error =~ /^Can't call method "isa" on unblessed reference/ ) {
539 # Its an unblessed reference
540 if( !UNIVERSAL::isa( $object, $class ) ) {
541 my $ref = ref $object;
542 $diag = "$obj_name isn't a '$class' it's a '$ref'";
547 WHOA! I tried to call ->isa on your object and got some weird error.
554 my $ref = ref $object;
555 $diag = "$obj_name isn't a '$class' it's a '$ref'";
561 $ok = $tb->ok( 0, $name );
562 $tb->diag(" $diag\n");
565 $ok = $tb->ok( 1, $name );
573 my $obj = new_ok( $class );
574 my $obj = new_ok( $class => \@args );
575 my $obj = new_ok( $class => \@args, $object_name );
577 A convenience function which combines creating an object and calling
578 isa_ok() on that object.
580 It is basically equivalent to:
582 my $obj = $class->new(@args);
583 isa_ok $obj, $class, $object_name;
585 If @args is not given, an empty list will be used.
587 This function only works on new() and it assumes new() will return
588 just a single object which isa C<$class>.
593 my $tb = Test::More->builder;
594 $tb->croak("new_ok() must be given at least a class") unless @_;
596 my( $class, $args, $object_name ) = @_;
599 $object_name = "The object" unless defined $object_name;
602 my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } );
604 local $Test::Builder::Level = $Test::Builder::Level + 1;
605 isa_ok $obj, $class, $object_name;
608 $tb->ok( 0, "new() died" );
609 $tb->diag(" Error was: $error");
622 Sometimes you just want to say that the tests have passed. Usually
623 the case is you've got some complicated condition that is difficult to
624 wedge into an ok(). In this case, you can simply use pass() (to
625 declare the test ok) or fail (for not ok). They are synonyms for
628 Use these very, very, very sparingly.
633 my $tb = Test::More->builder;
635 return $tb->ok( 1, @_ );
639 my $tb = Test::More->builder;
641 return $tb->ok( 0, @_ );
649 You usually want to test if the module you're testing loads ok, rather
650 than just vomiting if its load fails. For such purposes we have
651 C<use_ok> and C<require_ok>.
657 BEGIN { use_ok($module); }
658 BEGIN { use_ok($module, @imports); }
660 These simply use the given $module and test to make sure the load
661 happened ok. It's recommended that you run use_ok() inside a BEGIN
662 block so its functions are exported at compile-time and prototypes are
665 If @imports are given, they are passed through to the use. So this:
667 BEGIN { use_ok('Some::Module', qw(foo bar)) }
671 use Some::Module qw(foo bar);
673 Version numbers can be checked like so:
675 # Just like "use Some::Module 1.02"
676 BEGIN { use_ok('Some::Module', 1.02) }
678 Don't try to do this:
681 use_ok('Some::Module');
683 ...some code that depends on the use...
684 ...happening at compile time...
687 because the notion of "compile-time" is relative. Instead, you want:
689 BEGIN { use_ok('Some::Module') }
690 BEGIN { ...some code that depends on the use... }
696 my( $module, @imports ) = @_;
697 @imports = () unless @imports;
698 my $tb = Test::More->builder;
700 my( $pack, $filename, $line ) = caller;
703 if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
704 # probably a version check. Perl needs to see the bare number
705 # for it to work with non-Exporter based modules.
708 use $module $imports[0];
715 use $module \@{\$args[0]};
720 my( $eval_result, $eval_error ) = _eval( $code, \@imports );
721 my $ok = $tb->ok( $eval_result, "use $module;" );
725 $@ =~ s{^BEGIN failed--compilation aborted at .*$}
726 {BEGIN failed--compilation aborted at $filename line $line.}m;
727 $tb->diag(<<DIAGNOSTIC);
728 Tried to use '$module'.
738 my( $code, @args ) = @_;
740 # Work around oddities surrounding resetting of $@ by immediately
742 my( $sigdie, $eval_result, $eval_error );
744 local( $@, $!, $SIG{__DIE__} ); # isolate eval
745 $eval_result = eval $code; ## no critic (BuiltinFunctions::ProhibitStringyEval)
747 $sigdie = $SIG{__DIE__} || undef;
749 # make sure that $code got a chance to set $SIG{__DIE__}
750 $SIG{__DIE__} = $sigdie if defined $sigdie;
752 return( $eval_result, $eval_error );
760 Like use_ok(), except it requires the $module or $file.
766 my $tb = Test::More->builder;
770 # Try to deterine if we've been given a module name or file.
771 # Module names must be barewords, files not.
772 $module = qq['$module'] unless _is_module_name($module);
774 my $code = <<REQUIRE;
780 my( $eval_result, $eval_error ) = _eval($code);
781 my $ok = $tb->ok( $eval_result, "require $module;" );
785 $tb->diag(<<DIAGNOSTIC);
786 Tried to require '$module'.
795 sub _is_module_name {
798 # Module names start with a letter.
799 # End with an alphanumeric.
800 # The rest is an alphanumeric or ::
801 $module =~ s/\b::\b//g;
803 return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
809 =head2 Complex data structures
811 Not everything is a simple eq check or regex. There are times you
812 need to see if two data structures are equivalent. For these
813 instances Test::More provides a handful of useful functions.
815 B<NOTE> I'm not quite sure what will happen with filehandles.
821 is_deeply( $got, $expected, $test_name );
823 Similar to is(), except that if $got and $expected are references, it
824 does a deep comparison walking each data structure to see if they are
825 equivalent. If the two structures are different, it will display the
826 place where they start differing.
828 is_deeply() compares the dereferenced values of references, the
829 references themselves (except for their type) are ignored. This means
830 aspects such as blessing and ties are not considered "different".
832 is_deeply() current has very limited handling of function reference
833 and globs. It merely checks if they have the same referent. This may
834 improve in the future.
836 Test::Differences and Test::Deep provide more in-depth functionality
841 our( @Data_Stack, %Refs_Seen );
842 my $DNE = bless [], 'Does::Not::Exist';
845 return ref $_[0] eq ref $DNE;
848 ## no critic (Subroutines::RequireArgUnpacking)
850 my $tb = Test::More->builder;
852 unless( @_ == 2 or @_ == 3 ) {
853 my $msg = <<'WARNING';
854 is_deeply() takes two or three args, you gave %d.
855 This usually means you passed an array or hash instead
858 chop $msg; # clip off newline so carp() will put in line/file
860 _carp sprintf $msg, scalar @_;
865 my( $got, $expected, $name ) = @_;
867 $tb->_unoverload_str( \$expected, \$got );
870 if( !ref $got and !ref $expected ) { # neither is a reference
871 $ok = $tb->is_eq( $got, $expected, $name );
873 elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't
874 $ok = $tb->ok( 0, $name );
875 $tb->diag( _format_stack({ vals => [ $got, $expected ] }) );
877 else { # both references
878 local @Data_Stack = ();
879 if( _deep_check( $got, $expected ) ) {
880 $ok = $tb->ok( 1, $name );
883 $ok = $tb->ok( 0, $name );
884 $tb->diag( _format_stack(@Data_Stack) );
896 foreach my $entry (@Stack) {
897 my $type = $entry->{type} || '';
898 my $idx = $entry->{'idx'};
899 if( $type eq 'HASH' ) {
900 $var .= "->" unless $did_arrow++;
903 elsif( $type eq 'ARRAY' ) {
904 $var .= "->" unless $did_arrow++;
907 elsif( $type eq 'REF' ) {
912 my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ];
914 ( $vars[0] = $var ) =~ s/\$FOO/ \$got/;
915 ( $vars[1] = $var ) =~ s/\$FOO/\$expected/;
917 my $out = "Structures begin differing at:\n";
918 foreach my $idx ( 0 .. $#vals ) {
919 my $val = $vals[$idx];
921 = !defined $val ? 'undef'
922 : _dne($val) ? "Does not exist"
927 $out .= "$vars[0] = $vals[0]\n";
928 $out .= "$vars[1] = $vals[1]\n";
937 return '' if !ref $thing;
939 for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) {
940 return $type if UNIVERSAL::isa( $thing, $type );
951 If you pick the right test function, you'll usually get a good idea of
952 what went wrong when it failed. But sometimes it doesn't work out
953 that way. So here we have ways for you to write your own diagnostic
954 messages which are safer than just C<print STDERR>.
960 diag(@diagnostic_message);
962 Prints a diagnostic message which is guaranteed not to interfere with
963 test output. Like C<print> @diagnostic_message is simply concatenated
966 Returns false, so as to preserve failure.
968 Handy for this sort of thing:
970 ok( grep(/foo/, @users), "There's a foo user" ) or
971 diag("Since there's no foo, check that /etc/bar is set up right");
975 not ok 42 - There's a foo user
976 # Failed test 'There's a foo user'
977 # in foo.t at line 52.
978 # Since there's no foo, check that /etc/bar is set up right.
980 You might remember C<ok() or diag()> with the mnemonic C<open() or
983 B<NOTE> The exact formatting of the diagnostic output is still
984 changing, but it is guaranteed that whatever you throw at it it won't
985 interfere with the test.
989 note(@diagnostic_message);
991 Like diag(), except the message will not be seen when the test is run
992 in a harness. It will only be visible in the verbose TAP stream.
994 Handy for putting in notes which might be useful for debugging, but
995 don't indicate a problem.
997 note("Tempfile is $tempfile");
1002 return Test::More->builder->diag(@_);
1006 return Test::More->builder->note(@_);
1011 my @dump = explain @diagnostic_message;
1013 Will dump the contents of any references in a human readable format.
1014 Usually you want to pass this into C<note> or C<dump>.
1016 Handy for things like...
1018 is_deeply($have, $want) || diag explain $have;
1022 note explain \%args;
1023 Some::Class->method(%args);
1028 return Test::More->builder->explain(@_);
1034 =head2 Conditional tests
1036 Sometimes running a test under certain conditions will cause the
1037 test script to die. A certain function or method isn't implemented
1038 (such as fork() on MacOS), some resource isn't available (like a
1039 net connection) or a module isn't available. In these cases it's
1040 necessary to skip tests, or declare that they are supposed to fail
1041 but will work in the future (a todo test).
1043 For more details on the mechanics of skip and todo tests see
1046 The way Test::More handles this is with a named block. Basically, a
1047 block of tests which can be skipped over or made todo. It's best if I
1052 =item B<SKIP: BLOCK>
1055 skip $why, $how_many if $condition;
1057 ...normal testing code goes here...
1060 This declares a block of tests that might be skipped, $how_many tests
1061 there are, $why and under what $condition to skip them. An example is
1062 the easiest way to illustrate:
1065 eval { require HTML::Lint };
1067 skip "HTML::Lint not installed", 2 if $@;
1069 my $lint = new HTML::Lint;
1070 isa_ok( $lint, "HTML::Lint" );
1072 $lint->parse( $html );
1073 is( $lint->errors, 0, "No errors found in HTML" );
1076 If the user does not have HTML::Lint installed, the whole block of
1077 code I<won't be run at all>. Test::More will output special ok's
1078 which Test::Harness interprets as skipped, but passing, tests.
1080 It's important that $how_many accurately reflects the number of tests
1081 in the SKIP block so the # of tests run will match up with your plan.
1082 If your plan is C<no_plan> $how_many is optional and will default to 1.
1084 It's perfectly safe to nest SKIP blocks. Each SKIP block must have
1085 the label C<SKIP>, or Test::More can't work its magic.
1087 You don't skip tests which are failing because there's a bug in your
1088 program, or for which you don't yet have code written. For that you
1093 ## no critic (Subroutines::RequireFinalReturn)
1095 my( $why, $how_many ) = @_;
1096 my $tb = Test::More->builder;
1098 unless( defined $how_many ) {
1099 # $how_many can only be avoided when no_plan is in use.
1100 _carp "skip() needs to know \$how_many tests are in the block"
1101 unless $tb->has_plan eq 'no_plan';
1105 if( defined $how_many and $how_many =~ /\D/ ) {
1107 "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?";
1111 for( 1 .. $how_many ) {
1115 no warnings 'exiting';
1119 =item B<TODO: BLOCK>
1122 local $TODO = $why if $condition;
1124 ...normal testing code goes here...
1127 Declares a block of tests you expect to fail and $why. Perhaps it's
1128 because you haven't fixed a bug or haven't finished a new feature:
1131 local $TODO = "URI::Geller not finished";
1133 my $card = "Eight of clubs";
1134 is( URI::Geller->your_card, $card, 'Is THIS your card?' );
1137 URI::Geller->bend_spoon;
1138 is( $spoon, 'bent', "Spoon bending, that's original" );
1141 With a todo block, the tests inside are expected to fail. Test::More
1142 will run the tests normally, but print out special flags indicating
1143 they are "todo". Test::Harness will interpret failures as being ok.
1144 Should anything succeed, it will report it as an unexpected success.
1145 You then know the thing you had todo is done and can remove the
1148 The nice part about todo tests, as opposed to simply commenting out a
1149 block of tests, is it's like having a programmatic todo list. You know
1150 how much work is left to be done, you're aware of what bugs there are,
1151 and you'll know immediately when they're fixed.
1153 Once a todo test starts succeeding, simply move it outside the block.
1154 When the block is empty, delete it.
1156 B<NOTE>: TODO tests require a Test::Harness upgrade else it will
1157 treat it as a normal failure. See L<CAVEATS and NOTES>).
1163 todo_skip $why, $how_many if $condition;
1165 ...normal testing code...
1168 With todo tests, it's best to have the tests actually run. That way
1169 you'll know when they start passing. Sometimes this isn't possible.
1170 Often a failing test will cause the whole program to die or hang, even
1171 inside an C<eval BLOCK> with and using C<alarm>. In these extreme
1172 cases you have no choice but to skip over the broken tests entirely.
1174 The syntax and behavior is similar to a C<SKIP: BLOCK> except the
1175 tests will be marked as failing but todo. Test::Harness will
1176 interpret them as passing.
1181 my( $why, $how_many ) = @_;
1182 my $tb = Test::More->builder;
1184 unless( defined $how_many ) {
1185 # $how_many can only be avoided when no_plan is in use.
1186 _carp "todo_skip() needs to know \$how_many tests are in the block"
1187 unless $tb->has_plan eq 'no_plan';
1191 for( 1 .. $how_many ) {
1192 $tb->todo_skip($why);
1195 no warnings 'exiting';
1199 =item When do I use SKIP vs. TODO?
1201 B<If it's something the user might not be able to do>, use SKIP.
1202 This includes optional modules that aren't installed, running under
1203 an OS that doesn't have some feature (like fork() or symlinks), or maybe
1204 you need an Internet connection and one isn't available.
1206 B<If it's something the programmer hasn't done yet>, use TODO. This
1207 is for any code you haven't written yet, or bugs you have yet to fix,
1208 but want to put tests in your testing script (always a good idea).
1222 Indicates to the harness that things are going so badly all testing
1223 should terminate. This includes the running any additional test scripts.
1225 This is typically used when testing cannot continue such as a critical
1226 module failing to compile or a necessary external utility not being
1227 available such as a database connection failing.
1229 The test will exit with 255.
1235 my $tb = Test::More->builder;
1237 $tb->BAIL_OUT($reason);
1243 =head2 Discouraged comparison functions
1245 The use of the following functions is discouraged as they are not
1246 actually testing functions and produce no diagnostics to help figure
1247 out what went wrong. They were written before is_deeply() existed
1248 because I couldn't figure out how to display a useful diff of two
1249 arbitrary data structures.
1251 These functions are usually used inside an ok().
1253 ok( eq_array(\@got, \@expected) );
1255 C<is_deeply()> can do that better and with diagnostics.
1257 is_deeply( \@got, \@expected );
1259 They may be deprecated in future versions.
1265 my $is_eq = eq_array(\@got, \@expected);
1267 Checks if two arrays are equivalent. This is a deep check, so
1268 multi-level structures are handled correctly.
1274 local @Data_Stack = ();
1279 my( $a1, $a2 ) = @_;
1281 if( grep _type($_) ne 'ARRAY', $a1, $a2 ) {
1282 warn "eq_array passed a non-array ref";
1286 return 1 if $a1 eq $a2;
1289 my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
1291 my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
1292 my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
1294 push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] };
1295 $ok = _deep_check( $e1, $e2 );
1296 pop @Data_Stack if $ok;
1305 my( $e1, $e2 ) = @_;
1306 my $tb = Test::More->builder;
1310 # Effectively turn %Refs_Seen into a stack. This avoids picking up
1311 # the same referenced used twice (such as [\$a, \$a]) to be considered
1313 local %Refs_Seen = %Refs_Seen;
1316 # Quiet uninitialized value warnings when comparing undefs.
1317 no warnings 'uninitialized';
1319 $tb->_unoverload_str( \$e1, \$e2 );
1321 # Either they're both references or both not.
1322 my $same_ref = !( !ref $e1 xor !ref $e2 );
1323 my $not_ref = ( !ref $e1 and !ref $e2 );
1325 if( defined $e1 xor defined $e2 ) {
1328 elsif( _dne($e1) xor _dne($e2) ) {
1331 elsif( $same_ref and( $e1 eq $e2 ) ) {
1335 push @Data_Stack, { type => '', vals => [ $e1, $e2 ] };
1339 if( $Refs_Seen{$e1} ) {
1340 return $Refs_Seen{$e1} eq $e2;
1343 $Refs_Seen{$e1} = "$e2";
1346 my $type = _type($e1);
1347 $type = 'DIFFERENT' unless _type($e2) eq $type;
1349 if( $type eq 'DIFFERENT' ) {
1350 push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1353 elsif( $type eq 'ARRAY' ) {
1354 $ok = _eq_array( $e1, $e2 );
1356 elsif( $type eq 'HASH' ) {
1357 $ok = _eq_hash( $e1, $e2 );
1359 elsif( $type eq 'REF' ) {
1360 push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1361 $ok = _deep_check( $$e1, $$e2 );
1362 pop @Data_Stack if $ok;
1364 elsif( $type eq 'SCALAR' ) {
1365 push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] };
1366 $ok = _deep_check( $$e1, $$e2 );
1367 pop @Data_Stack if $ok;
1370 push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1374 _whoa( 1, "No type in _deep_check" );
1383 my( $check, $desc ) = @_;
1387 This should never happen! Please contact the author immediately!
1394 my $is_eq = eq_hash(\%got, \%expected);
1396 Determines if the two hashes contain the same keys and values. This
1402 local @Data_Stack = ();
1403 return _deep_check(@_);
1407 my( $a1, $a2 ) = @_;
1409 if( grep _type($_) ne 'HASH', $a1, $a2 ) {
1410 warn "eq_hash passed a non-hash ref";
1414 return 1 if $a1 eq $a2;
1417 my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
1418 foreach my $k ( keys %$bigger ) {
1419 my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
1420 my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
1422 push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] };
1423 $ok = _deep_check( $e1, $e2 );
1424 pop @Data_Stack if $ok;
1434 my $is_eq = eq_set(\@got, \@expected);
1436 Similar to eq_array(), except the order of the elements is B<not>
1437 important. This is a deep check, but the irrelevancy of order only
1438 applies to the top level.
1440 ok( eq_set(\@got, \@expected) );
1444 is_deeply( [sort @got], [sort @expected] );
1446 B<NOTE> By historical accident, this is not a true set comparison.
1447 While the order of elements does not matter, duplicate elements do.
1449 B<NOTE> eq_set() does not know how to deal with references at the top
1450 level. The following is an example of a comparison which might not work:
1452 eq_set([\1, \2], [\2, \1]);
1454 Test::Deep contains much better set comparison functions.
1459 my( $a1, $a2 ) = @_;
1460 return 0 unless @$a1 == @$a2;
1462 no warnings 'uninitialized';
1464 # It really doesn't matter how we sort them, as long as both arrays are
1465 # sorted with the same algorithm.
1467 # Ensure that references are not accidentally treated the same as a
1468 # string containing the reference.
1470 # Have to inline the sort routine due to a threading/sort bug.
1471 # See [rt.cpan.org 6782]
1473 # I don't know how references would be sorted so we just don't sort
1474 # them. This means eq_set doesn't really work with refs.
1476 [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ],
1477 [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ],
1484 =head2 Extending and Embedding Test::More
1486 Sometimes the Test::More interface isn't quite enough. Fortunately,
1487 Test::More is built on top of Test::Builder which provides a single,
1488 unified backend for any test library to use. This means two test
1489 libraries which both use Test::Builder B<can be used together in the
1492 If you simply want to do a little tweaking of how the tests behave,
1493 you can access the underlying Test::Builder object like so:
1499 my $test_builder = Test::More->builder;
1501 Returns the Test::Builder object underlying Test::More for you to play
1510 If all your tests passed, Test::Builder will exit with zero (which is
1511 normal). If anything failed it will exit with how many failed. If
1512 you run less (or more) tests than you planned, the missing (or extras)
1513 will be considered failures. If no tests were ever run Test::Builder
1514 will throw a warning and exit with 255. If the test died, even after
1515 having successfully completed all its tests, it will still be
1516 considered a failure and will exit with 255.
1518 So the exit codes are...
1520 0 all tests successful
1521 255 test died or all passed but wrong # of tests run
1522 any other number how many failed (including missing or extras)
1524 If you fail more than 254 tests, it will be reported as 254.
1526 B<NOTE> This behavior may go away in future versions.
1529 =head1 CAVEATS and NOTES
1533 =item Backwards compatibility
1535 Test::More works with Perls as old as 5.6.0.
1538 =item Overloaded objects
1540 String overloaded objects are compared B<as strings> (or in cmp_ok()'s
1541 case, strings or numbers as appropriate to the comparison op). This
1542 prevents Test::More from piercing an object's interface allowing
1543 better blackbox testing. So if a function starts returning overloaded
1544 objects instead of bare strings your tests won't notice the
1545 difference. This is good.
1547 However, it does mean that functions like is_deeply() cannot be used to
1548 test the internals of string overloaded objects. In this case I would
1549 suggest Test::Deep which contains more flexible testing functions for
1550 complex data structures.
1555 Test::More will only be aware of threads if "use threads" has been done
1556 I<before> Test::More is loaded. This is ok:
1561 This may cause problems:
1566 5.8.1 and above are supported. Anything below that has too many bugs.
1569 =item Test::Harness upgrade
1571 no_plan and todo depend on new Test::Harness features and fixes. If
1572 you're going to distribute tests that use no_plan or todo your
1573 end-users will have to upgrade Test::Harness to the latest one on
1574 CPAN. If you avoid no_plan and TODO tests, the stock Test::Harness
1577 Installing Test::More should also upgrade Test::Harness.
1584 This is a case of convergent evolution with Joshua Pritikin's Test
1585 module. I was largely unaware of its existence when I'd first
1586 written my own ok() routines. This module exists because I can't
1587 figure out how to easily wedge test names into Test's interface (along
1588 with a few other problems).
1590 The goal here is to have a testing utility that's simple to learn,
1591 quick to use and difficult to trip yourself up with while still
1592 providing more flexibility than the existing Test.pm. As such, the
1593 names of the most common routines are kept tiny, special cases and
1594 magic side-effects are kept to a minimum. WYSIWYG.
1599 L<Test::Simple> if all this confuses you and you just want to write
1600 some tests. You can upgrade to Test::More later (it's forward
1603 L<Test::Harness> is the test runner and output interpreter for Perl.
1604 It's the thing that powers C<make test> and where the C<prove> utility
1607 L<Test::Legacy> tests written with Test.pm, the original testing
1608 module, do not play well with other testing libraries. Test::Legacy
1609 emulates the Test.pm interface and does play well with others.
1611 L<Test::Differences> for more ways to test complex data structures.
1612 And it plays well with Test::More.
1614 L<Test::Class> is like xUnit but more perlish.
1616 L<Test::Deep> gives you more powerful complex data structure testing.
1618 L<Test::Inline> shows the idea of embedded testing.
1620 L<Bundle::Test> installs a whole bunch of useful test modules.
1625 Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
1626 from Joshua Pritikin's Test module and lots of help from Barrie
1627 Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and
1633 See F<http://rt.cpan.org> to report and view bugs.
1638 Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1640 This program is free software; you can redistribute it and/or
1641 modify it under the same terms as Perl itself.
1643 See F<http://www.perl.com/perl/misc/Artistic.html>