7 #---- perlcritic exemptions. ----#
9 # We use a lot of subroutine prototypes
10 ## no critic (Subroutines::ProhibitSubroutinePrototypes)
12 # Can't use Carp because it might cause use_ok() to accidentally succeed
13 # even though the module being used forgot to use Carp. Yes, this
16 my( $file, $line ) = ( caller(1) )[ 1, 2 ];
17 return warn @_, " at $file line $line\n";
20 our $VERSION = '0.88';
21 $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
23 use Test::Builder::Module;
24 our @ISA = qw(Test::Builder::Module);
25 our @EXPORT = qw(ok use_ok require_ok
26 is isnt like unlike is_deeply
30 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 skip_all => $reason;
49 use Test::More; # see done_testing()
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 L<Test::Simple> first. This is a drop in replacement for Test::Simple
100 which you can switch to once you get the hang of basic testing.
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 cases when you will not know beforehand how many tests your
120 script is going to run. In this case, you can declare your tests at
125 ... run your tests ...
127 done_testing( $number_of_tests_run );
129 Sometimes you really don't know how many tests were run, or it's too
130 difficult to calculate. In which case you can leave off
131 $number_of_tests_run.
133 In some cases, you'll want to completely skip an entire testing script.
135 use Test::More skip_all => $skip_reason;
137 Your script will declare a skip with the reason why you skipped and
138 exit immediately with a zero (success). See L<Test::Harness> for
141 If you want to control what functions Test::More will export, you
142 have to use the 'import' option. For example, to import everything
143 but 'fail', you'd do:
145 use Test::More tests => 23, import => ['!fail'];
147 Alternatively, you can use the plan() function. Useful for when you
148 have to calculate the number of tests.
151 plan tests => keys %Stuff * 3;
153 or for deciding between running the tests at all:
156 if( $^O eq 'MacOS' ) {
157 plan skip_all => 'Test irrelevant on MacOS';
166 my $tb = Test::More->builder;
168 return $tb->plan(@_);
171 # This implements "use Test::More 'no_diag'" but the behavior is
179 while( $idx <= $#{$list} ) {
180 my $item = $list->[$idx];
182 if( defined $item and $item eq 'no_diag' ) {
183 $class->builder->no_diag(1);
199 =item B<done_testing>
202 done_testing($number_of_tests);
204 If you don't know how many tests you're going to run, you can issue
205 the plan when you're done running tests.
207 $number_of_tests is the same as plan(), it's the number of tests you
208 expected to run. You can omit this, in which case the number of tests
209 you ran doesn't matter, just the fact that your tests ran to
212 This is safer than and replaces the "no_plan" plan.
219 my $tb = Test::More->builder;
220 $tb->done_testing(@_);
225 By convention, each test is assigned a number in order. This is
226 largely done automatically for you. However, it's often very useful to
227 assign a name to each test. Which would you rather see:
235 ok 4 - basic multi-variable
236 not ok 5 - simple exponential
237 ok 6 - force == mass * acceleration
239 The later gives you some idea of what failed. It also makes it easier
240 to find the test in your script, simply search for "simple
243 All test functions take a name argument. It's optional, but highly
244 suggested that you use it.
247 =head2 I'm ok, you're not ok.
249 The basic purpose of this module is to print out either "ok #" or "not
250 ok #" depending on if a given test succeeded or failed. Everything
253 All of the following print "ok" or "not ok" depending on if the test
254 succeeded or failed. They all also return true or false,
261 ok($got eq $expected, $test_name);
263 This simply evaluates any expression (C<$got eq $expected> is just a
264 simple example) and uses that to determine if the test succeeded or
265 failed. A true expression passes, a false one fails. Very simple.
269 ok( $exp{9} == 81, 'simple exponential' );
270 ok( Film->can('db_Main'), 'set_db()' );
271 ok( $p->tests == 4, 'saw tests' );
272 ok( !grep !defined $_, @items, 'items populated' );
274 (Mnemonic: "This is ok.")
276 $test_name is a very short description of the test that will be printed
277 out. It makes it very easy to find a test in your script when it fails
278 and gives others an idea of your intentions. $test_name is optional,
279 but we B<very> strongly encourage its use.
281 Should an ok() fail, it will produce some diagnostics:
283 not ok 18 - sufficient mucus
284 # Failed test 'sufficient mucus'
285 # in foo.t at line 42.
287 This is the same as Test::Simple's ok() routine.
292 my( $test, $name ) = @_;
293 my $tb = Test::More->builder;
295 return $tb->ok( $test, $name );
302 is ( $got, $expected, $test_name );
303 isnt( $got, $expected, $test_name );
305 Similar to ok(), is() and isnt() compare their two arguments
306 with C<eq> and C<ne> respectively and use the result of that to
307 determine if the test succeeded or failed. So these:
309 # Is the ultimate answer 42?
310 is( ultimate_answer(), 42, "Meaning of Life" );
313 isnt( $foo, '', "Got some foo" );
315 are similar to these:
317 ok( ultimate_answer() eq 42, "Meaning of Life" );
318 ok( $foo ne '', "Got some foo" );
320 (Mnemonic: "This is that." "This isn't that.")
322 So why use these? They produce better diagnostics on failure. ok()
323 cannot know what you are testing for (beyond the name), but is() and
324 isnt() know what the test was and why it failed. For example this
327 my $foo = 'waffle'; my $bar = 'yarblokos';
328 is( $foo, $bar, 'Is foo the same as bar?' );
330 Will produce something like this:
332 not ok 17 - Is foo the same as bar?
333 # Failed test 'Is foo the same as bar?'
334 # in foo.t at line 139.
336 # expected: 'yarblokos'
338 So you can figure out what went wrong without rerunning the test.
340 You are encouraged to use is() and isnt() over ok() where possible,
341 however do not be tempted to use them to find out if something is
345 is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' );
347 This does not check if C<exists $brooklyn{tree}> is true, it checks if
348 it returns 1. Very different. Similar caveats exist for false and 0.
349 In these cases, use ok().
351 ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' );
353 A simple call to isnt() usually does not provide a strong test but there
354 are cases when you cannot say much more about a value than that it is
355 different from some other value:
359 my $clone = $obj->clone;
360 isa_ok $obj, "Foo", "Foo->clone";
362 isnt $obj, $clone, "clone() produces a different object";
364 For those grammatical pedants out there, there's an C<isn't()>
365 function which is an alias of isnt().
370 my $tb = Test::More->builder;
372 return $tb->is_eq(@_);
376 my $tb = Test::More->builder;
378 return $tb->isnt_eq(@_);
385 like( $got, qr/expected/, $test_name );
387 Similar to ok(), like() matches $got against the regex C<qr/expected/>.
391 like($got, qr/expected/, 'this is like that');
395 ok( $got =~ /expected/, 'this is like that');
397 (Mnemonic "This is like that".)
399 The second argument is a regular expression. It may be given as a
400 regex reference (i.e. C<qr//>) or (for better compatibility with older
401 perls) as a string that looks like a regex (alternative delimiters are
402 currently not supported):
404 like( $got, '/expected/', 'this is like that' );
406 Regex options may be placed on the end (C<'/expected/i'>).
408 Its advantages over ok() are similar to that of is() and isnt(). Better
409 diagnostics on failure.
414 my $tb = Test::More->builder;
416 return $tb->like(@_);
421 unlike( $got, qr/expected/, $test_name );
423 Works exactly as like(), only it checks if $got B<does not> match the
429 my $tb = Test::More->builder;
431 return $tb->unlike(@_);
436 cmp_ok( $got, $op, $expected, $test_name );
438 Halfway between ok() and is() lies cmp_ok(). This allows you to
439 compare two arguments using any binary perl operator.
441 # ok( $got eq $expected );
442 cmp_ok( $got, 'eq', $expected, 'this eq that' );
444 # ok( $got == $expected );
445 cmp_ok( $got, '==', $expected, 'this == that' );
447 # ok( $got && $expected );
448 cmp_ok( $got, '&&', $expected, 'this && that' );
451 Its advantage over ok() is when the test fails you'll know what $got
455 # Failed test in foo.t at line 12.
460 It's also useful in those cases where you are comparing numbers and
461 is()'s use of C<eq> will interfere:
463 cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
465 It's especially useful when comparing greater-than or smaller-than
466 relation between values:
468 cmp_ok( $some_value, '<=', $upper_limit );
474 my $tb = Test::More->builder;
476 return $tb->cmp_ok(@_);
481 can_ok($module, @methods);
482 can_ok($object, @methods);
484 Checks to make sure the $module or $object can do these @methods
485 (works with functions, too).
487 can_ok('Foo', qw(this that whatever));
489 is almost exactly like saying:
491 ok( Foo->can('this') &&
496 only without all the typing and with a better interface. Handy for
497 quickly testing an interface.
499 No matter how many @methods you check, a single can_ok() call counts
500 as one test. If you desire otherwise, use:
502 foreach my $meth (@methods) {
503 can_ok('Foo', $meth);
509 my( $proto, @methods ) = @_;
510 my $class = ref $proto || $proto;
511 my $tb = Test::More->builder;
514 my $ok = $tb->ok( 0, "->can(...)" );
515 $tb->diag(' can_ok() called with empty class or reference');
520 my $ok = $tb->ok( 0, "$class->can(...)" );
521 $tb->diag(' can_ok() called with no methods');
526 foreach my $method (@methods) {
527 $tb->_try( sub { $proto->can($method) } ) or push @nok, $method;
530 my $name = (@methods == 1) ? "$class->can('$methods[0]')" :
533 my $ok = $tb->ok( !@nok, $name );
535 $tb->diag( map " $class->can('$_') failed\n", @nok );
542 isa_ok($object, $class, $object_name);
543 isa_ok($subclass, $class, $object_name);
544 isa_ok($ref, $type, $ref_name);
546 Checks to see if the given C<< $object->isa($class) >>. Also checks to make
547 sure the object was defined in the first place. Handy for this sort
550 my $obj = Some::Module->new;
551 isa_ok( $obj, 'Some::Module' );
553 where you'd otherwise have to write
555 my $obj = Some::Module->new;
556 ok( defined $obj && $obj->isa('Some::Module') );
558 to safeguard against your test script blowing up.
560 You can also test a class, to make sure that it has the right ancestor:
562 isa_ok( 'Vole', 'Rodent' );
564 It works on references, too:
566 isa_ok( $array_ref, 'ARRAY' );
568 The diagnostics of this test normally just refer to 'the object'. If
569 you'd like them to be more specific, you can supply an $object_name
570 (for example 'Test customer').
575 my( $object, $class, $obj_name ) = @_;
576 my $tb = Test::More->builder;
580 if( !defined $object ) {
581 $obj_name = 'The thing' unless defined $obj_name;
582 $diag = "$obj_name isn't defined";
585 my $whatami = ref $object ? 'object' : 'class';
586 # We can't use UNIVERSAL::isa because we want to honor isa() overrides
587 my( $rslt, $error ) = $tb->_try( sub { $object->isa($class) } );
589 if( $error =~ /^Can't call method "isa" on unblessed reference/ ) {
590 # Its an unblessed reference
591 $obj_name = 'The reference' unless defined $obj_name;
592 if( !UNIVERSAL::isa( $object, $class ) ) {
593 my $ref = ref $object;
594 $diag = "$obj_name isn't a '$class' it's a '$ref'";
597 elsif( $error =~ /Can't call method "isa" without a package/ ) {
598 # It's something that can't even be a class
599 $diag = "$obj_name isn't a class or reference";
603 WHOA! I tried to call ->isa on your $whatami and got some weird error.
610 $obj_name = "The $whatami" unless defined $obj_name;
612 my $ref = ref $object;
613 $diag = "$obj_name isn't a '$class' it's a '$ref'";
618 my $name = "$obj_name isa $class";
621 $ok = $tb->ok( 0, $name );
622 $tb->diag(" $diag\n");
625 $ok = $tb->ok( 1, $name );
633 my $obj = new_ok( $class );
634 my $obj = new_ok( $class => \@args );
635 my $obj = new_ok( $class => \@args, $object_name );
637 A convenience function which combines creating an object and calling
638 isa_ok() on that object.
640 It is basically equivalent to:
642 my $obj = $class->new(@args);
643 isa_ok $obj, $class, $object_name;
645 If @args is not given, an empty list will be used.
647 This function only works on new() and it assumes new() will return
648 just a single object which isa C<$class>.
653 my $tb = Test::More->builder;
654 $tb->croak("new_ok() must be given at least a class") unless @_;
656 my( $class, $args, $object_name ) = @_;
659 $object_name = "The object" unless defined $object_name;
662 my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } );
664 local $Test::Builder::Level = $Test::Builder::Level + 1;
665 isa_ok $obj, $class, $object_name;
668 $tb->ok( 0, "new() died" );
669 $tb->diag(" Error was: $error");
682 Sometimes you just want to say that the tests have passed. Usually
683 the case is you've got some complicated condition that is difficult to
684 wedge into an ok(). In this case, you can simply use pass() (to
685 declare the test ok) or fail (for not ok). They are synonyms for
688 Use these very, very, very sparingly.
693 my $tb = Test::More->builder;
695 return $tb->ok( 1, @_ );
699 my $tb = Test::More->builder;
701 return $tb->ok( 0, @_ );
709 You usually want to test if the module you're testing loads ok, rather
710 than just vomiting if its load fails. For such purposes we have
711 C<use_ok> and C<require_ok>.
717 BEGIN { use_ok($module); }
718 BEGIN { use_ok($module, @imports); }
720 These simply use the given $module and test to make sure the load
721 happened ok. It's recommended that you run use_ok() inside a BEGIN
722 block so its functions are exported at compile-time and prototypes are
725 If @imports are given, they are passed through to the use. So this:
727 BEGIN { use_ok('Some::Module', qw(foo bar)) }
731 use Some::Module qw(foo bar);
733 Version numbers can be checked like so:
735 # Just like "use Some::Module 1.02"
736 BEGIN { use_ok('Some::Module', 1.02) }
738 Don't try to do this:
741 use_ok('Some::Module');
743 ...some code that depends on the use...
744 ...happening at compile time...
747 because the notion of "compile-time" is relative. Instead, you want:
749 BEGIN { use_ok('Some::Module') }
750 BEGIN { ...some code that depends on the use... }
756 my( $module, @imports ) = @_;
757 @imports = () unless @imports;
758 my $tb = Test::More->builder;
760 my( $pack, $filename, $line ) = caller;
763 if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
764 # probably a version check. Perl needs to see the bare number
765 # for it to work with non-Exporter based modules.
768 use $module $imports[0];
775 use $module \@{\$args[0]};
780 my( $eval_result, $eval_error ) = _eval( $code, \@imports );
781 my $ok = $tb->ok( $eval_result, "use $module;" );
785 $@ =~ s{^BEGIN failed--compilation aborted at .*$}
786 {BEGIN failed--compilation aborted at $filename line $line.}m;
787 $tb->diag(<<DIAGNOSTIC);
788 Tried to use '$module'.
798 my( $code, @args ) = @_;
800 # Work around oddities surrounding resetting of $@ by immediately
802 my( $sigdie, $eval_result, $eval_error );
804 local( $@, $!, $SIG{__DIE__} ); # isolate eval
805 $eval_result = eval $code; ## no critic (BuiltinFunctions::ProhibitStringyEval)
807 $sigdie = $SIG{__DIE__} || undef;
809 # make sure that $code got a chance to set $SIG{__DIE__}
810 $SIG{__DIE__} = $sigdie if defined $sigdie;
812 return( $eval_result, $eval_error );
820 Like use_ok(), except it requires the $module or $file.
826 my $tb = Test::More->builder;
830 # Try to deterine if we've been given a module name or file.
831 # Module names must be barewords, files not.
832 $module = qq['$module'] unless _is_module_name($module);
834 my $code = <<REQUIRE;
840 my( $eval_result, $eval_error ) = _eval($code);
841 my $ok = $tb->ok( $eval_result, "require $module;" );
845 $tb->diag(<<DIAGNOSTIC);
846 Tried to require '$module'.
855 sub _is_module_name {
858 # Module names start with a letter.
859 # End with an alphanumeric.
860 # The rest is an alphanumeric or ::
861 $module =~ s/\b::\b//g;
863 return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
869 =head2 Complex data structures
871 Not everything is a simple eq check or regex. There are times you
872 need to see if two data structures are equivalent. For these
873 instances Test::More provides a handful of useful functions.
875 B<NOTE> I'm not quite sure what will happen with filehandles.
881 is_deeply( $got, $expected, $test_name );
883 Similar to is(), except that if $got and $expected are references, it
884 does a deep comparison walking each data structure to see if they are
885 equivalent. If the two structures are different, it will display the
886 place where they start differing.
888 is_deeply() compares the dereferenced values of references, the
889 references themselves (except for their type) are ignored. This means
890 aspects such as blessing and ties are not considered "different".
892 is_deeply() currently has very limited handling of function reference
893 and globs. It merely checks if they have the same referent. This may
894 improve in the future.
896 L<Test::Differences> and L<Test::Deep> provide more in-depth functionality
901 our( @Data_Stack, %Refs_Seen );
902 my $DNE = bless [], 'Does::Not::Exist';
905 return ref $_[0] eq ref $DNE;
908 ## no critic (Subroutines::RequireArgUnpacking)
910 my $tb = Test::More->builder;
912 unless( @_ == 2 or @_ == 3 ) {
913 my $msg = <<'WARNING';
914 is_deeply() takes two or three args, you gave %d.
915 This usually means you passed an array or hash instead
918 chop $msg; # clip off newline so carp() will put in line/file
920 _carp sprintf $msg, scalar @_;
925 my( $got, $expected, $name ) = @_;
927 $tb->_unoverload_str( \$expected, \$got );
930 if( !ref $got and !ref $expected ) { # neither is a reference
931 $ok = $tb->is_eq( $got, $expected, $name );
933 elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't
934 $ok = $tb->ok( 0, $name );
935 $tb->diag( _format_stack({ vals => [ $got, $expected ] }) );
937 else { # both references
938 local @Data_Stack = ();
939 if( _deep_check( $got, $expected ) ) {
940 $ok = $tb->ok( 1, $name );
943 $ok = $tb->ok( 0, $name );
944 $tb->diag( _format_stack(@Data_Stack) );
956 foreach my $entry (@Stack) {
957 my $type = $entry->{type} || '';
958 my $idx = $entry->{'idx'};
959 if( $type eq 'HASH' ) {
960 $var .= "->" unless $did_arrow++;
963 elsif( $type eq 'ARRAY' ) {
964 $var .= "->" unless $did_arrow++;
967 elsif( $type eq 'REF' ) {
972 my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ];
974 ( $vars[0] = $var ) =~ s/\$FOO/ \$got/;
975 ( $vars[1] = $var ) =~ s/\$FOO/\$expected/;
977 my $out = "Structures begin differing at:\n";
978 foreach my $idx ( 0 .. $#vals ) {
979 my $val = $vals[$idx];
981 = !defined $val ? 'undef'
982 : _dne($val) ? "Does not exist"
987 $out .= "$vars[0] = $vals[0]\n";
988 $out .= "$vars[1] = $vals[1]\n";
997 return '' if !ref $thing;
999 for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) {
1000 return $type if UNIVERSAL::isa( $thing, $type );
1011 If you pick the right test function, you'll usually get a good idea of
1012 what went wrong when it failed. But sometimes it doesn't work out
1013 that way. So here we have ways for you to write your own diagnostic
1014 messages which are safer than just C<print STDERR>.
1020 diag(@diagnostic_message);
1022 Prints a diagnostic message which is guaranteed not to interfere with
1023 test output. Like C<print> @diagnostic_message is simply concatenated
1026 Returns false, so as to preserve failure.
1028 Handy for this sort of thing:
1030 ok( grep(/foo/, @users), "There's a foo user" ) or
1031 diag("Since there's no foo, check that /etc/bar is set up right");
1033 which would produce:
1035 not ok 42 - There's a foo user
1036 # Failed test 'There's a foo user'
1037 # in foo.t at line 52.
1038 # Since there's no foo, check that /etc/bar is set up right.
1040 You might remember C<ok() or diag()> with the mnemonic C<open() or
1043 B<NOTE> The exact formatting of the diagnostic output is still
1044 changing, but it is guaranteed that whatever you throw at it it won't
1045 interfere with the test.
1049 note(@diagnostic_message);
1051 Like diag(), except the message will not be seen when the test is run
1052 in a harness. It will only be visible in the verbose TAP stream.
1054 Handy for putting in notes which might be useful for debugging, but
1055 don't indicate a problem.
1057 note("Tempfile is $tempfile");
1062 return Test::More->builder->diag(@_);
1066 return Test::More->builder->note(@_);
1071 my @dump = explain @diagnostic_message;
1073 Will dump the contents of any references in a human readable format.
1074 Usually you want to pass this into C<note> or C<diag>.
1076 Handy for things like...
1078 is_deeply($have, $want) || diag explain $have;
1082 note explain \%args;
1083 Some::Class->method(%args);
1088 return Test::More->builder->explain(@_);
1094 =head2 Conditional tests
1096 Sometimes running a test under certain conditions will cause the
1097 test script to die. A certain function or method isn't implemented
1098 (such as fork() on MacOS), some resource isn't available (like a
1099 net connection) or a module isn't available. In these cases it's
1100 necessary to skip tests, or declare that they are supposed to fail
1101 but will work in the future (a todo test).
1103 For more details on the mechanics of skip and todo tests see
1106 The way Test::More handles this is with a named block. Basically, a
1107 block of tests which can be skipped over or made todo. It's best if I
1112 =item B<SKIP: BLOCK>
1115 skip $why, $how_many if $condition;
1117 ...normal testing code goes here...
1120 This declares a block of tests that might be skipped, $how_many tests
1121 there are, $why and under what $condition to skip them. An example is
1122 the easiest way to illustrate:
1125 eval { require HTML::Lint };
1127 skip "HTML::Lint not installed", 2 if $@;
1129 my $lint = new HTML::Lint;
1130 isa_ok( $lint, "HTML::Lint" );
1132 $lint->parse( $html );
1133 is( $lint->errors, 0, "No errors found in HTML" );
1136 If the user does not have HTML::Lint installed, the whole block of
1137 code I<won't be run at all>. Test::More will output special ok's
1138 which Test::Harness interprets as skipped, but passing, tests.
1140 It's important that $how_many accurately reflects the number of tests
1141 in the SKIP block so the # of tests run will match up with your plan.
1142 If your plan is C<no_plan> $how_many is optional and will default to 1.
1144 It's perfectly safe to nest SKIP blocks. Each SKIP block must have
1145 the label C<SKIP>, or Test::More can't work its magic.
1147 You don't skip tests which are failing because there's a bug in your
1148 program, or for which you don't yet have code written. For that you
1153 ## no critic (Subroutines::RequireFinalReturn)
1155 my( $why, $how_many ) = @_;
1156 my $tb = Test::More->builder;
1158 unless( defined $how_many ) {
1159 # $how_many can only be avoided when no_plan is in use.
1160 _carp "skip() needs to know \$how_many tests are in the block"
1161 unless $tb->has_plan eq 'no_plan';
1165 if( defined $how_many and $how_many =~ /\D/ ) {
1167 "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?";
1171 for( 1 .. $how_many ) {
1175 no warnings 'exiting';
1179 =item B<TODO: BLOCK>
1182 local $TODO = $why if $condition;
1184 ...normal testing code goes here...
1187 Declares a block of tests you expect to fail and $why. Perhaps it's
1188 because you haven't fixed a bug or haven't finished a new feature:
1191 local $TODO = "URI::Geller not finished";
1193 my $card = "Eight of clubs";
1194 is( URI::Geller->your_card, $card, 'Is THIS your card?' );
1197 URI::Geller->bend_spoon;
1198 is( $spoon, 'bent', "Spoon bending, that's original" );
1201 With a todo block, the tests inside are expected to fail. Test::More
1202 will run the tests normally, but print out special flags indicating
1203 they are "todo". Test::Harness will interpret failures as being ok.
1204 Should anything succeed, it will report it as an unexpected success.
1205 You then know the thing you had todo is done and can remove the
1208 The nice part about todo tests, as opposed to simply commenting out a
1209 block of tests, is it's like having a programmatic todo list. You know
1210 how much work is left to be done, you're aware of what bugs there are,
1211 and you'll know immediately when they're fixed.
1213 Once a todo test starts succeeding, simply move it outside the block.
1214 When the block is empty, delete it.
1216 B<NOTE>: TODO tests require a Test::Harness upgrade else it will
1217 treat it as a normal failure. See L<CAVEATS and NOTES>).
1223 todo_skip $why, $how_many if $condition;
1225 ...normal testing code...
1228 With todo tests, it's best to have the tests actually run. That way
1229 you'll know when they start passing. Sometimes this isn't possible.
1230 Often a failing test will cause the whole program to die or hang, even
1231 inside an C<eval BLOCK> with and using C<alarm>. In these extreme
1232 cases you have no choice but to skip over the broken tests entirely.
1234 The syntax and behavior is similar to a C<SKIP: BLOCK> except the
1235 tests will be marked as failing but todo. Test::Harness will
1236 interpret them as passing.
1241 my( $why, $how_many ) = @_;
1242 my $tb = Test::More->builder;
1244 unless( defined $how_many ) {
1245 # $how_many can only be avoided when no_plan is in use.
1246 _carp "todo_skip() needs to know \$how_many tests are in the block"
1247 unless $tb->has_plan eq 'no_plan';
1251 for( 1 .. $how_many ) {
1252 $tb->todo_skip($why);
1255 no warnings 'exiting';
1259 =item When do I use SKIP vs. TODO?
1261 B<If it's something the user might not be able to do>, use SKIP.
1262 This includes optional modules that aren't installed, running under
1263 an OS that doesn't have some feature (like fork() or symlinks), or maybe
1264 you need an Internet connection and one isn't available.
1266 B<If it's something the programmer hasn't done yet>, use TODO. This
1267 is for any code you haven't written yet, or bugs you have yet to fix,
1268 but want to put tests in your testing script (always a good idea).
1282 Indicates to the harness that things are going so badly all testing
1283 should terminate. This includes the running any additional test scripts.
1285 This is typically used when testing cannot continue such as a critical
1286 module failing to compile or a necessary external utility not being
1287 available such as a database connection failing.
1289 The test will exit with 255.
1291 For even better control look at L<Test::Most>.
1297 my $tb = Test::More->builder;
1299 $tb->BAIL_OUT($reason);
1305 =head2 Discouraged comparison functions
1307 The use of the following functions is discouraged as they are not
1308 actually testing functions and produce no diagnostics to help figure
1309 out what went wrong. They were written before is_deeply() existed
1310 because I couldn't figure out how to display a useful diff of two
1311 arbitrary data structures.
1313 These functions are usually used inside an ok().
1315 ok( eq_array(\@got, \@expected) );
1317 C<is_deeply()> can do that better and with diagnostics.
1319 is_deeply( \@got, \@expected );
1321 They may be deprecated in future versions.
1327 my $is_eq = eq_array(\@got, \@expected);
1329 Checks if two arrays are equivalent. This is a deep check, so
1330 multi-level structures are handled correctly.
1336 local @Data_Stack = ();
1341 my( $a1, $a2 ) = @_;
1343 if( grep _type($_) ne 'ARRAY', $a1, $a2 ) {
1344 warn "eq_array passed a non-array ref";
1348 return 1 if $a1 eq $a2;
1351 my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
1353 my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
1354 my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
1356 push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] };
1357 $ok = _deep_check( $e1, $e2 );
1358 pop @Data_Stack if $ok;
1367 my( $e1, $e2 ) = @_;
1368 my $tb = Test::More->builder;
1372 # Effectively turn %Refs_Seen into a stack. This avoids picking up
1373 # the same referenced used twice (such as [\$a, \$a]) to be considered
1375 local %Refs_Seen = %Refs_Seen;
1378 # Quiet uninitialized value warnings when comparing undefs.
1379 no warnings 'uninitialized';
1381 $tb->_unoverload_str( \$e1, \$e2 );
1383 # Either they're both references or both not.
1384 my $same_ref = !( !ref $e1 xor !ref $e2 );
1385 my $not_ref = ( !ref $e1 and !ref $e2 );
1387 if( defined $e1 xor defined $e2 ) {
1390 elsif( !defined $e1 and !defined $e2 ) {
1391 # Shortcut if they're both defined.
1394 elsif( _dne($e1) xor _dne($e2) ) {
1397 elsif( $same_ref and( $e1 eq $e2 ) ) {
1401 push @Data_Stack, { type => '', vals => [ $e1, $e2 ] };
1405 if( $Refs_Seen{$e1} ) {
1406 return $Refs_Seen{$e1} eq $e2;
1409 $Refs_Seen{$e1} = "$e2";
1412 my $type = _type($e1);
1413 $type = 'DIFFERENT' unless _type($e2) eq $type;
1415 if( $type eq 'DIFFERENT' ) {
1416 push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1419 elsif( $type eq 'ARRAY' ) {
1420 $ok = _eq_array( $e1, $e2 );
1422 elsif( $type eq 'HASH' ) {
1423 $ok = _eq_hash( $e1, $e2 );
1425 elsif( $type eq 'REF' ) {
1426 push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1427 $ok = _deep_check( $$e1, $$e2 );
1428 pop @Data_Stack if $ok;
1430 elsif( $type eq 'SCALAR' ) {
1431 push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] };
1432 $ok = _deep_check( $$e1, $$e2 );
1433 pop @Data_Stack if $ok;
1436 push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1440 _whoa( 1, "No type in _deep_check" );
1449 my( $check, $desc ) = @_;
1453 This should never happen! Please contact the author immediately!
1460 my $is_eq = eq_hash(\%got, \%expected);
1462 Determines if the two hashes contain the same keys and values. This
1468 local @Data_Stack = ();
1469 return _deep_check(@_);
1473 my( $a1, $a2 ) = @_;
1475 if( grep _type($_) ne 'HASH', $a1, $a2 ) {
1476 warn "eq_hash passed a non-hash ref";
1480 return 1 if $a1 eq $a2;
1483 my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
1484 foreach my $k ( keys %$bigger ) {
1485 my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
1486 my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
1488 push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] };
1489 $ok = _deep_check( $e1, $e2 );
1490 pop @Data_Stack if $ok;
1500 my $is_eq = eq_set(\@got, \@expected);
1502 Similar to eq_array(), except the order of the elements is B<not>
1503 important. This is a deep check, but the irrelevancy of order only
1504 applies to the top level.
1506 ok( eq_set(\@got, \@expected) );
1510 is_deeply( [sort @got], [sort @expected] );
1512 B<NOTE> By historical accident, this is not a true set comparison.
1513 While the order of elements does not matter, duplicate elements do.
1515 B<NOTE> eq_set() does not know how to deal with references at the top
1516 level. The following is an example of a comparison which might not work:
1518 eq_set([\1, \2], [\2, \1]);
1520 L<Test::Deep> contains much better set comparison functions.
1525 my( $a1, $a2 ) = @_;
1526 return 0 unless @$a1 == @$a2;
1528 no warnings 'uninitialized';
1530 # It really doesn't matter how we sort them, as long as both arrays are
1531 # sorted with the same algorithm.
1533 # Ensure that references are not accidentally treated the same as a
1534 # string containing the reference.
1536 # Have to inline the sort routine due to a threading/sort bug.
1537 # See [rt.cpan.org 6782]
1539 # I don't know how references would be sorted so we just don't sort
1540 # them. This means eq_set doesn't really work with refs.
1542 [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ],
1543 [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ],
1550 =head2 Extending and Embedding Test::More
1552 Sometimes the Test::More interface isn't quite enough. Fortunately,
1553 Test::More is built on top of Test::Builder which provides a single,
1554 unified backend for any test library to use. This means two test
1555 libraries which both use Test::Builder B<can be used together in the
1558 If you simply want to do a little tweaking of how the tests behave,
1559 you can access the underlying Test::Builder object like so:
1565 my $test_builder = Test::More->builder;
1567 Returns the Test::Builder object underlying Test::More for you to play
1576 If all your tests passed, Test::Builder will exit with zero (which is
1577 normal). If anything failed it will exit with how many failed. If
1578 you run less (or more) tests than you planned, the missing (or extras)
1579 will be considered failures. If no tests were ever run Test::Builder
1580 will throw a warning and exit with 255. If the test died, even after
1581 having successfully completed all its tests, it will still be
1582 considered a failure and will exit with 255.
1584 So the exit codes are...
1586 0 all tests successful
1587 255 test died or all passed but wrong # of tests run
1588 any other number how many failed (including missing or extras)
1590 If you fail more than 254 tests, it will be reported as 254.
1592 B<NOTE> This behavior may go away in future versions.
1595 =head1 CAVEATS and NOTES
1599 =item Backwards compatibility
1601 Test::More works with Perls as old as 5.6.0.
1604 =item Overloaded objects
1606 String overloaded objects are compared B<as strings> (or in cmp_ok()'s
1607 case, strings or numbers as appropriate to the comparison op). This
1608 prevents Test::More from piercing an object's interface allowing
1609 better blackbox testing. So if a function starts returning overloaded
1610 objects instead of bare strings your tests won't notice the
1611 difference. This is good.
1613 However, it does mean that functions like is_deeply() cannot be used to
1614 test the internals of string overloaded objects. In this case I would
1615 suggest L<Test::Deep> which contains more flexible testing functions for
1616 complex data structures.
1621 Test::More will only be aware of threads if "use threads" has been done
1622 I<before> Test::More is loaded. This is ok:
1627 This may cause problems:
1632 5.8.1 and above are supported. Anything below that has too many bugs.
1635 =item Test::Harness upgrade
1637 no_plan, todo and done_testing() depend on new Test::Harness features
1638 and fixes. If you're going to distribute tests that use no_plan or
1639 todo your end-users will have to upgrade Test::Harness to the latest
1640 one on CPAN. If you avoid no_plan and TODO tests, the stock
1641 Test::Harness will work fine.
1643 Installing Test::More should also upgrade Test::Harness.
1650 This is a case of convergent evolution with Joshua Pritikin's Test
1651 module. I was largely unaware of its existence when I'd first
1652 written my own ok() routines. This module exists because I can't
1653 figure out how to easily wedge test names into Test's interface (along
1654 with a few other problems).
1656 The goal here is to have a testing utility that's simple to learn,
1657 quick to use and difficult to trip yourself up with while still
1658 providing more flexibility than the existing Test.pm. As such, the
1659 names of the most common routines are kept tiny, special cases and
1660 magic side-effects are kept to a minimum. WYSIWYG.
1665 L<Test::Simple> if all this confuses you and you just want to write
1666 some tests. You can upgrade to Test::More later (it's forward
1669 L<Test::Harness> is the test runner and output interpreter for Perl.
1670 It's the thing that powers C<make test> and where the C<prove> utility
1673 L<Test::Legacy> tests written with Test.pm, the original testing
1674 module, do not play well with other testing libraries. Test::Legacy
1675 emulates the Test.pm interface and does play well with others.
1677 L<Test::Differences> for more ways to test complex data structures.
1678 And it plays well with Test::More.
1680 L<Test::Class> is like xUnit but more perlish.
1682 L<Test::Deep> gives you more powerful complex data structure testing.
1684 L<Test::Inline> shows the idea of embedded testing.
1686 L<Bundle::Test> installs a whole bunch of useful test modules.
1691 Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
1692 from Joshua Pritikin's Test module and lots of help from Barrie
1693 Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and
1699 See F<http://rt.cpan.org> to report and view bugs.
1704 The source code repository for Test::More can be found at
1705 F<http://github.com/schwern/test-more/>.
1710 Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1712 This program is free software; you can redistribute it and/or
1713 modify it under the same terms as Perl itself.
1715 See F<http://www.perl.com/perl/misc/Artistic.html>