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.94';
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
42 Test::More - yet another framework for writing test scripts
46 use Test::More tests => 23;
48 use Test::More skip_all => $reason;
50 use Test::More; # see done_testing()
52 BEGIN { use_ok( 'Some::Module' ); }
53 require_ok( 'Some::Module' );
55 # Various ways to say "ok"
56 ok($got eq $expected, $test_name);
58 is ($got, $expected, $test_name);
59 isnt($got, $expected, $test_name);
61 # Rather than print STDERR "# here's what went wrong\n"
62 diag("here's what went wrong");
64 like ($got, qr/expected/, $test_name);
65 unlike($got, qr/expected/, $test_name);
67 cmp_ok($got, '==', $expected, $test_name);
69 is_deeply($got_complex_structure, $expected_complex_structure, $test_name);
72 skip $why, $how_many unless $have_some_feature;
74 ok( foo(), $test_name );
75 is( foo(42), 23, $test_name );
81 ok( foo(), $test_name );
82 is( foo(42), 23, $test_name );
85 can_ok($module, @methods);
86 isa_ok($object, $class);
94 my @status = Test::More::status;
99 B<STOP!> If you're just getting started writing tests, have a look at
100 L<Test::Simple> first. This is a drop in replacement for Test::Simple
101 which you can switch to once you get the hang of basic testing.
103 The purpose of this module is to provide a wide range of testing
104 utilities. Various ways to say "ok" with better diagnostics,
105 facilities to skip tests, test future features and compare complicated
106 data structures. While you can do almost anything with a simple
107 C<ok()> function, it doesn't provide good diagnostic output.
110 =head2 I love it when a plan comes together
112 Before anything else, you need a testing plan. This basically declares
113 how many tests your script is going to run to protect against premature
116 The preferred way to do this is to declare a plan when you C<use Test::More>.
118 use Test::More tests => 23;
120 There are cases when you will not know beforehand how many tests your
121 script is going to run. In this case, you can declare your tests at
126 ... run your tests ...
128 done_testing( $number_of_tests_run );
130 Sometimes you really don't know how many tests were run, or it's too
131 difficult to calculate. In which case you can leave off
132 $number_of_tests_run.
134 In some cases, you'll want to completely skip an entire testing script.
136 use Test::More skip_all => $skip_reason;
138 Your script will declare a skip with the reason why you skipped and
139 exit immediately with a zero (success). See L<Test::Harness> for
142 If you want to control what functions Test::More will export, you
143 have to use the 'import' option. For example, to import everything
144 but 'fail', you'd do:
146 use Test::More tests => 23, import => ['!fail'];
148 Alternatively, you can use the plan() function. Useful for when you
149 have to calculate the number of tests.
152 plan tests => keys %Stuff * 3;
154 or for deciding between running the tests at all:
157 if( $^O eq 'MacOS' ) {
158 plan skip_all => 'Test irrelevant on MacOS';
167 my $tb = Test::More->builder;
169 return $tb->plan(@_);
172 # This implements "use Test::More 'no_diag'" but the behavior is
180 while( $idx <= $#{$list} ) {
181 my $item = $list->[$idx];
183 if( defined $item and $item eq 'no_diag' ) {
184 $class->builder->no_diag(1);
200 =item B<done_testing>
203 done_testing($number_of_tests);
205 If you don't know how many tests you're going to run, you can issue
206 the plan when you're done running tests.
208 $number_of_tests is the same as plan(), it's the number of tests you
209 expected to run. You can omit this, in which case the number of tests
210 you ran doesn't matter, just the fact that your tests ran to
213 This is safer than and replaces the "no_plan" plan.
220 my $tb = Test::More->builder;
221 $tb->done_testing(@_);
226 By convention, each test is assigned a number in order. This is
227 largely done automatically for you. However, it's often very useful to
228 assign a name to each test. Which would you rather see:
236 ok 4 - basic multi-variable
237 not ok 5 - simple exponential
238 ok 6 - force == mass * acceleration
240 The later gives you some idea of what failed. It also makes it easier
241 to find the test in your script, simply search for "simple
244 All test functions take a name argument. It's optional, but highly
245 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 $obj_name = 'The thing' unless defined $obj_name;
600 $diag = "$obj_name isn't a class or reference";
604 WHOA! I tried to call ->isa on your $whatami and got some weird error.
611 $obj_name = "The $whatami" unless defined $obj_name;
613 my $ref = ref $object;
614 $diag = "$obj_name isn't a '$class' it's a '$ref'";
619 my $name = "$obj_name isa $class";
622 $ok = $tb->ok( 0, $name );
623 $tb->diag(" $diag\n");
626 $ok = $tb->ok( 1, $name );
634 my $obj = new_ok( $class );
635 my $obj = new_ok( $class => \@args );
636 my $obj = new_ok( $class => \@args, $object_name );
638 A convenience function which combines creating an object and calling
639 isa_ok() on that object.
641 It is basically equivalent to:
643 my $obj = $class->new(@args);
644 isa_ok $obj, $class, $object_name;
646 If @args is not given, an empty list will be used.
648 This function only works on new() and it assumes new() will return
649 just a single object which isa C<$class>.
654 my $tb = Test::More->builder;
655 $tb->croak("new_ok() must be given at least a class") unless @_;
657 my( $class, $args, $object_name ) = @_;
660 $object_name = "The object" unless defined $object_name;
663 my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } );
665 local $Test::Builder::Level = $Test::Builder::Level + 1;
666 isa_ok $obj, $class, $object_name;
669 $tb->ok( 0, "new() died" );
670 $tb->diag(" Error was: $error");
678 subtest $name => \&code;
680 subtest() runs the &code as its own little test with its own plan and
681 its own result. The main test counts this as a single test using the
682 result of the whole subtest to determine if its ok or not ok.
686 use Test::More tests => 3;
690 subtest 'An example subtest' => sub {
693 pass("This is a subtest");
704 ok 1 - This is a subtest
706 ok 2 - An example subtest
709 A subtest may call "skip_all". No tests will be run, but the subtest is
712 subtest 'skippy' => sub {
713 plan skip_all => 'cuz I said so';
714 pass('this test will never be run');
717 Returns true if the subtest passed, false otherwise.
722 my ($name, $subtests) = @_;
724 my $tb = Test::More->builder;
725 return $tb->subtest(@_);
735 Sometimes you just want to say that the tests have passed. Usually
736 the case is you've got some complicated condition that is difficult to
737 wedge into an ok(). In this case, you can simply use pass() (to
738 declare the test ok) or fail (for not ok). They are synonyms for
741 Use these very, very, very sparingly.
746 my $tb = Test::More->builder;
748 return $tb->ok( 1, @_ );
752 my $tb = Test::More->builder;
754 return $tb->ok( 0, @_ );
762 You usually want to test if the module you're testing loads ok, rather
763 than just vomiting if its load fails. For such purposes we have
764 C<use_ok> and C<require_ok>.
770 BEGIN { use_ok($module); }
771 BEGIN { use_ok($module, @imports); }
773 These simply use the given $module and test to make sure the load
774 happened ok. It's recommended that you run use_ok() inside a BEGIN
775 block so its functions are exported at compile-time and prototypes are
778 If @imports are given, they are passed through to the use. So this:
780 BEGIN { use_ok('Some::Module', qw(foo bar)) }
784 use Some::Module qw(foo bar);
786 Version numbers can be checked like so:
788 # Just like "use Some::Module 1.02"
789 BEGIN { use_ok('Some::Module', 1.02) }
791 Don't try to do this:
794 use_ok('Some::Module');
796 ...some code that depends on the use...
797 ...happening at compile time...
800 because the notion of "compile-time" is relative. Instead, you want:
802 BEGIN { use_ok('Some::Module') }
803 BEGIN { ...some code that depends on the use... }
809 my( $module, @imports ) = @_;
810 @imports = () unless @imports;
811 my $tb = Test::More->builder;
813 my( $pack, $filename, $line ) = caller;
816 if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
817 # probably a version check. Perl needs to see the bare number
818 # for it to work with non-Exporter based modules.
821 use $module $imports[0];
828 use $module \@{\$args[0]};
833 my( $eval_result, $eval_error ) = _eval( $code, \@imports );
834 my $ok = $tb->ok( $eval_result, "use $module;" );
838 $@ =~ s{^BEGIN failed--compilation aborted at .*$}
839 {BEGIN failed--compilation aborted at $filename line $line.}m;
840 $tb->diag(<<DIAGNOSTIC);
841 Tried to use '$module'.
851 my( $code, @args ) = @_;
853 # Work around oddities surrounding resetting of $@ by immediately
855 my( $sigdie, $eval_result, $eval_error );
857 local( $@, $!, $SIG{__DIE__} ); # isolate eval
858 $eval_result = eval $code; ## no critic (BuiltinFunctions::ProhibitStringyEval)
860 $sigdie = $SIG{__DIE__} || undef;
862 # make sure that $code got a chance to set $SIG{__DIE__}
863 $SIG{__DIE__} = $sigdie if defined $sigdie;
865 return( $eval_result, $eval_error );
873 Like use_ok(), except it requires the $module or $file.
879 my $tb = Test::More->builder;
883 # Try to deterine if we've been given a module name or file.
884 # Module names must be barewords, files not.
885 $module = qq['$module'] unless _is_module_name($module);
887 my $code = <<REQUIRE;
893 my( $eval_result, $eval_error ) = _eval($code);
894 my $ok = $tb->ok( $eval_result, "require $module;" );
898 $tb->diag(<<DIAGNOSTIC);
899 Tried to require '$module'.
908 sub _is_module_name {
911 # Module names start with a letter.
912 # End with an alphanumeric.
913 # The rest is an alphanumeric or ::
914 $module =~ s/\b::\b//g;
916 return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
922 =head2 Complex data structures
924 Not everything is a simple eq check or regex. There are times you
925 need to see if two data structures are equivalent. For these
926 instances Test::More provides a handful of useful functions.
928 B<NOTE> I'm not quite sure what will happen with filehandles.
934 is_deeply( $got, $expected, $test_name );
936 Similar to is(), except that if $got and $expected are references, it
937 does a deep comparison walking each data structure to see if they are
938 equivalent. If the two structures are different, it will display the
939 place where they start differing.
941 is_deeply() compares the dereferenced values of references, the
942 references themselves (except for their type) are ignored. This means
943 aspects such as blessing and ties are not considered "different".
945 is_deeply() currently has very limited handling of function reference
946 and globs. It merely checks if they have the same referent. This may
947 improve in the future.
949 L<Test::Differences> and L<Test::Deep> provide more in-depth functionality
954 our( @Data_Stack, %Refs_Seen );
955 my $DNE = bless [], 'Does::Not::Exist';
958 return ref $_[0] eq ref $DNE;
961 ## no critic (Subroutines::RequireArgUnpacking)
963 my $tb = Test::More->builder;
965 unless( @_ == 2 or @_ == 3 ) {
966 my $msg = <<'WARNING';
967 is_deeply() takes two or three args, you gave %d.
968 This usually means you passed an array or hash instead
971 chop $msg; # clip off newline so carp() will put in line/file
973 _carp sprintf $msg, scalar @_;
978 my( $got, $expected, $name ) = @_;
980 $tb->_unoverload_str( \$expected, \$got );
983 if( !ref $got and !ref $expected ) { # neither is a reference
984 $ok = $tb->is_eq( $got, $expected, $name );
986 elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't
987 $ok = $tb->ok( 0, $name );
988 $tb->diag( _format_stack({ vals => [ $got, $expected ] }) );
990 else { # both references
991 local @Data_Stack = ();
992 if( _deep_check( $got, $expected ) ) {
993 $ok = $tb->ok( 1, $name );
996 $ok = $tb->ok( 0, $name );
997 $tb->diag( _format_stack(@Data_Stack) );
1009 foreach my $entry (@Stack) {
1010 my $type = $entry->{type} || '';
1011 my $idx = $entry->{'idx'};
1012 if( $type eq 'HASH' ) {
1013 $var .= "->" unless $did_arrow++;
1016 elsif( $type eq 'ARRAY' ) {
1017 $var .= "->" unless $did_arrow++;
1020 elsif( $type eq 'REF' ) {
1025 my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ];
1027 ( $vars[0] = $var ) =~ s/\$FOO/ \$got/;
1028 ( $vars[1] = $var ) =~ s/\$FOO/\$expected/;
1030 my $out = "Structures begin differing at:\n";
1031 foreach my $idx ( 0 .. $#vals ) {
1032 my $val = $vals[$idx];
1034 = !defined $val ? 'undef'
1035 : _dne($val) ? "Does not exist"
1040 $out .= "$vars[0] = $vals[0]\n";
1041 $out .= "$vars[1] = $vals[1]\n";
1050 return '' if !ref $thing;
1052 for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) {
1053 return $type if UNIVERSAL::isa( $thing, $type );
1064 If you pick the right test function, you'll usually get a good idea of
1065 what went wrong when it failed. But sometimes it doesn't work out
1066 that way. So here we have ways for you to write your own diagnostic
1067 messages which are safer than just C<print STDERR>.
1073 diag(@diagnostic_message);
1075 Prints a diagnostic message which is guaranteed not to interfere with
1076 test output. Like C<print> @diagnostic_message is simply concatenated
1079 Returns false, so as to preserve failure.
1081 Handy for this sort of thing:
1083 ok( grep(/foo/, @users), "There's a foo user" ) or
1084 diag("Since there's no foo, check that /etc/bar is set up right");
1086 which would produce:
1088 not ok 42 - There's a foo user
1089 # Failed test 'There's a foo user'
1090 # in foo.t at line 52.
1091 # Since there's no foo, check that /etc/bar is set up right.
1093 You might remember C<ok() or diag()> with the mnemonic C<open() or
1096 B<NOTE> The exact formatting of the diagnostic output is still
1097 changing, but it is guaranteed that whatever you throw at it it won't
1098 interfere with the test.
1102 note(@diagnostic_message);
1104 Like diag(), except the message will not be seen when the test is run
1105 in a harness. It will only be visible in the verbose TAP stream.
1107 Handy for putting in notes which might be useful for debugging, but
1108 don't indicate a problem.
1110 note("Tempfile is $tempfile");
1115 return Test::More->builder->diag(@_);
1119 return Test::More->builder->note(@_);
1124 my @dump = explain @diagnostic_message;
1126 Will dump the contents of any references in a human readable format.
1127 Usually you want to pass this into C<note> or C<diag>.
1129 Handy for things like...
1131 is_deeply($have, $want) || diag explain $have;
1135 note explain \%args;
1136 Some::Class->method(%args);
1141 return Test::More->builder->explain(@_);
1147 =head2 Conditional tests
1149 Sometimes running a test under certain conditions will cause the
1150 test script to die. A certain function or method isn't implemented
1151 (such as fork() on MacOS), some resource isn't available (like a
1152 net connection) or a module isn't available. In these cases it's
1153 necessary to skip tests, or declare that they are supposed to fail
1154 but will work in the future (a todo test).
1156 For more details on the mechanics of skip and todo tests see
1159 The way Test::More handles this is with a named block. Basically, a
1160 block of tests which can be skipped over or made todo. It's best if I
1165 =item B<SKIP: BLOCK>
1168 skip $why, $how_many if $condition;
1170 ...normal testing code goes here...
1173 This declares a block of tests that might be skipped, $how_many tests
1174 there are, $why and under what $condition to skip them. An example is
1175 the easiest way to illustrate:
1178 eval { require HTML::Lint };
1180 skip "HTML::Lint not installed", 2 if $@;
1182 my $lint = new HTML::Lint;
1183 isa_ok( $lint, "HTML::Lint" );
1185 $lint->parse( $html );
1186 is( $lint->errors, 0, "No errors found in HTML" );
1189 If the user does not have HTML::Lint installed, the whole block of
1190 code I<won't be run at all>. Test::More will output special ok's
1191 which Test::Harness interprets as skipped, but passing, tests.
1193 It's important that $how_many accurately reflects the number of tests
1194 in the SKIP block so the # of tests run will match up with your plan.
1195 If your plan is C<no_plan> $how_many is optional and will default to 1.
1197 It's perfectly safe to nest SKIP blocks. Each SKIP block must have
1198 the label C<SKIP>, or Test::More can't work its magic.
1200 You don't skip tests which are failing because there's a bug in your
1201 program, or for which you don't yet have code written. For that you
1206 ## no critic (Subroutines::RequireFinalReturn)
1208 my( $why, $how_many ) = @_;
1209 my $tb = Test::More->builder;
1211 unless( defined $how_many ) {
1212 # $how_many can only be avoided when no_plan is in use.
1213 _carp "skip() needs to know \$how_many tests are in the block"
1214 unless $tb->has_plan eq 'no_plan';
1218 if( defined $how_many and $how_many =~ /\D/ ) {
1220 "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?";
1224 for( 1 .. $how_many ) {
1228 no warnings 'exiting';
1232 =item B<TODO: BLOCK>
1235 local $TODO = $why if $condition;
1237 ...normal testing code goes here...
1240 Declares a block of tests you expect to fail and $why. Perhaps it's
1241 because you haven't fixed a bug or haven't finished a new feature:
1244 local $TODO = "URI::Geller not finished";
1246 my $card = "Eight of clubs";
1247 is( URI::Geller->your_card, $card, 'Is THIS your card?' );
1250 URI::Geller->bend_spoon;
1251 is( $spoon, 'bent', "Spoon bending, that's original" );
1254 With a todo block, the tests inside are expected to fail. Test::More
1255 will run the tests normally, but print out special flags indicating
1256 they are "todo". Test::Harness will interpret failures as being ok.
1257 Should anything succeed, it will report it as an unexpected success.
1258 You then know the thing you had todo is done and can remove the
1261 The nice part about todo tests, as opposed to simply commenting out a
1262 block of tests, is it's like having a programmatic todo list. You know
1263 how much work is left to be done, you're aware of what bugs there are,
1264 and you'll know immediately when they're fixed.
1266 Once a todo test starts succeeding, simply move it outside the block.
1267 When the block is empty, delete it.
1273 todo_skip $why, $how_many if $condition;
1275 ...normal testing code...
1278 With todo tests, it's best to have the tests actually run. That way
1279 you'll know when they start passing. Sometimes this isn't possible.
1280 Often a failing test will cause the whole program to die or hang, even
1281 inside an C<eval BLOCK> with and using C<alarm>. In these extreme
1282 cases you have no choice but to skip over the broken tests entirely.
1284 The syntax and behavior is similar to a C<SKIP: BLOCK> except the
1285 tests will be marked as failing but todo. Test::Harness will
1286 interpret them as passing.
1291 my( $why, $how_many ) = @_;
1292 my $tb = Test::More->builder;
1294 unless( defined $how_many ) {
1295 # $how_many can only be avoided when no_plan is in use.
1296 _carp "todo_skip() needs to know \$how_many tests are in the block"
1297 unless $tb->has_plan eq 'no_plan';
1301 for( 1 .. $how_many ) {
1302 $tb->todo_skip($why);
1305 no warnings 'exiting';
1309 =item When do I use SKIP vs. TODO?
1311 B<If it's something the user might not be able to do>, use SKIP.
1312 This includes optional modules that aren't installed, running under
1313 an OS that doesn't have some feature (like fork() or symlinks), or maybe
1314 you need an Internet connection and one isn't available.
1316 B<If it's something the programmer hasn't done yet>, use TODO. This
1317 is for any code you haven't written yet, or bugs you have yet to fix,
1318 but want to put tests in your testing script (always a good idea).
1332 Indicates to the harness that things are going so badly all testing
1333 should terminate. This includes the running any additional test scripts.
1335 This is typically used when testing cannot continue such as a critical
1336 module failing to compile or a necessary external utility not being
1337 available such as a database connection failing.
1339 The test will exit with 255.
1341 For even better control look at L<Test::Most>.
1347 my $tb = Test::More->builder;
1349 $tb->BAIL_OUT($reason);
1355 =head2 Discouraged comparison functions
1357 The use of the following functions is discouraged as they are not
1358 actually testing functions and produce no diagnostics to help figure
1359 out what went wrong. They were written before is_deeply() existed
1360 because I couldn't figure out how to display a useful diff of two
1361 arbitrary data structures.
1363 These functions are usually used inside an ok().
1365 ok( eq_array(\@got, \@expected) );
1367 C<is_deeply()> can do that better and with diagnostics.
1369 is_deeply( \@got, \@expected );
1371 They may be deprecated in future versions.
1377 my $is_eq = eq_array(\@got, \@expected);
1379 Checks if two arrays are equivalent. This is a deep check, so
1380 multi-level structures are handled correctly.
1386 local @Data_Stack = ();
1391 my( $a1, $a2 ) = @_;
1393 if( grep _type($_) ne 'ARRAY', $a1, $a2 ) {
1394 warn "eq_array passed a non-array ref";
1398 return 1 if $a1 eq $a2;
1401 my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
1403 my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
1404 my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
1406 push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] };
1407 $ok = _deep_check( $e1, $e2 );
1408 pop @Data_Stack if $ok;
1417 my( $e1, $e2 ) = @_;
1418 my $tb = Test::More->builder;
1422 # Effectively turn %Refs_Seen into a stack. This avoids picking up
1423 # the same referenced used twice (such as [\$a, \$a]) to be considered
1425 local %Refs_Seen = %Refs_Seen;
1428 # Quiet uninitialized value warnings when comparing undefs.
1429 no warnings 'uninitialized';
1431 $tb->_unoverload_str( \$e1, \$e2 );
1433 # Either they're both references or both not.
1434 my $same_ref = !( !ref $e1 xor !ref $e2 );
1435 my $not_ref = ( !ref $e1 and !ref $e2 );
1437 if( defined $e1 xor defined $e2 ) {
1440 elsif( !defined $e1 and !defined $e2 ) {
1441 # Shortcut if they're both defined.
1444 elsif( _dne($e1) xor _dne($e2) ) {
1447 elsif( $same_ref and( $e1 eq $e2 ) ) {
1451 push @Data_Stack, { type => '', vals => [ $e1, $e2 ] };
1455 if( $Refs_Seen{$e1} ) {
1456 return $Refs_Seen{$e1} eq $e2;
1459 $Refs_Seen{$e1} = "$e2";
1462 my $type = _type($e1);
1463 $type = 'DIFFERENT' unless _type($e2) eq $type;
1465 if( $type eq 'DIFFERENT' ) {
1466 push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1469 elsif( $type eq 'ARRAY' ) {
1470 $ok = _eq_array( $e1, $e2 );
1472 elsif( $type eq 'HASH' ) {
1473 $ok = _eq_hash( $e1, $e2 );
1475 elsif( $type eq 'REF' ) {
1476 push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1477 $ok = _deep_check( $$e1, $$e2 );
1478 pop @Data_Stack if $ok;
1480 elsif( $type eq 'SCALAR' ) {
1481 push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] };
1482 $ok = _deep_check( $$e1, $$e2 );
1483 pop @Data_Stack if $ok;
1486 push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
1490 _whoa( 1, "No type in _deep_check" );
1499 my( $check, $desc ) = @_;
1503 This should never happen! Please contact the author immediately!
1510 my $is_eq = eq_hash(\%got, \%expected);
1512 Determines if the two hashes contain the same keys and values. This
1518 local @Data_Stack = ();
1519 return _deep_check(@_);
1523 my( $a1, $a2 ) = @_;
1525 if( grep _type($_) ne 'HASH', $a1, $a2 ) {
1526 warn "eq_hash passed a non-hash ref";
1530 return 1 if $a1 eq $a2;
1533 my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
1534 foreach my $k ( keys %$bigger ) {
1535 my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
1536 my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
1538 push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] };
1539 $ok = _deep_check( $e1, $e2 );
1540 pop @Data_Stack if $ok;
1550 my $is_eq = eq_set(\@got, \@expected);
1552 Similar to eq_array(), except the order of the elements is B<not>
1553 important. This is a deep check, but the irrelevancy of order only
1554 applies to the top level.
1556 ok( eq_set(\@got, \@expected) );
1560 is_deeply( [sort @got], [sort @expected] );
1562 B<NOTE> By historical accident, this is not a true set comparison.
1563 While the order of elements does not matter, duplicate elements do.
1565 B<NOTE> eq_set() does not know how to deal with references at the top
1566 level. The following is an example of a comparison which might not work:
1568 eq_set([\1, \2], [\2, \1]);
1570 L<Test::Deep> contains much better set comparison functions.
1575 my( $a1, $a2 ) = @_;
1576 return 0 unless @$a1 == @$a2;
1578 no warnings 'uninitialized';
1580 # It really doesn't matter how we sort them, as long as both arrays are
1581 # sorted with the same algorithm.
1583 # Ensure that references are not accidentally treated the same as a
1584 # string containing the reference.
1586 # Have to inline the sort routine due to a threading/sort bug.
1587 # See [rt.cpan.org 6782]
1589 # I don't know how references would be sorted so we just don't sort
1590 # them. This means eq_set doesn't really work with refs.
1592 [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ],
1593 [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ],
1600 =head2 Extending and Embedding Test::More
1602 Sometimes the Test::More interface isn't quite enough. Fortunately,
1603 Test::More is built on top of Test::Builder which provides a single,
1604 unified backend for any test library to use. This means two test
1605 libraries which both use Test::Builder B<can be used together in the
1608 If you simply want to do a little tweaking of how the tests behave,
1609 you can access the underlying Test::Builder object like so:
1615 my $test_builder = Test::More->builder;
1617 Returns the Test::Builder object underlying Test::More for you to play
1626 If all your tests passed, Test::Builder will exit with zero (which is
1627 normal). If anything failed it will exit with how many failed. If
1628 you run less (or more) tests than you planned, the missing (or extras)
1629 will be considered failures. If no tests were ever run Test::Builder
1630 will throw a warning and exit with 255. If the test died, even after
1631 having successfully completed all its tests, it will still be
1632 considered a failure and will exit with 255.
1634 So the exit codes are...
1636 0 all tests successful
1637 255 test died or all passed but wrong # of tests run
1638 any other number how many failed (including missing or extras)
1640 If you fail more than 254 tests, it will be reported as 254.
1642 B<NOTE> This behavior may go away in future versions.
1645 =head1 CAVEATS and NOTES
1649 =item Backwards compatibility
1651 Test::More works with Perls as old as 5.6.0.
1654 =item utf8 / "Wide character in print"
1656 If you use utf8 or other non-ASCII characters with Test::More you
1657 might get a "Wide character in print" warning. Using C<binmode
1658 STDOUT, ":utf8"> will not fix it. Test::Builder (which powers
1659 Test::More) duplicates STDOUT and STDERR. So any changes to them,
1660 including changing their output disciplines, will not be seem by
1663 The work around is to change the filehandles used by Test::Builder
1666 my $builder = Test::More->builder;
1667 binmode $builder->output, ":utf8";
1668 binmode $builder->failure_output, ":utf8";
1669 binmode $builder->todo_output, ":utf8";
1672 =item Overloaded objects
1674 String overloaded objects are compared B<as strings> (or in cmp_ok()'s
1675 case, strings or numbers as appropriate to the comparison op). This
1676 prevents Test::More from piercing an object's interface allowing
1677 better blackbox testing. So if a function starts returning overloaded
1678 objects instead of bare strings your tests won't notice the
1679 difference. This is good.
1681 However, it does mean that functions like is_deeply() cannot be used to
1682 test the internals of string overloaded objects. In this case I would
1683 suggest L<Test::Deep> which contains more flexible testing functions for
1684 complex data structures.
1689 Test::More will only be aware of threads if "use threads" has been done
1690 I<before> Test::More is loaded. This is ok:
1695 This may cause problems:
1700 5.8.1 and above are supported. Anything below that has too many bugs.
1707 This is a case of convergent evolution with Joshua Pritikin's Test
1708 module. I was largely unaware of its existence when I'd first
1709 written my own ok() routines. This module exists because I can't
1710 figure out how to easily wedge test names into Test's interface (along
1711 with a few other problems).
1713 The goal here is to have a testing utility that's simple to learn,
1714 quick to use and difficult to trip yourself up with while still
1715 providing more flexibility than the existing Test.pm. As such, the
1716 names of the most common routines are kept tiny, special cases and
1717 magic side-effects are kept to a minimum. WYSIWYG.
1722 L<Test::Simple> if all this confuses you and you just want to write
1723 some tests. You can upgrade to Test::More later (it's forward
1726 L<Test::Harness> is the test runner and output interpreter for Perl.
1727 It's the thing that powers C<make test> and where the C<prove> utility
1730 L<Test::Legacy> tests written with Test.pm, the original testing
1731 module, do not play well with other testing libraries. Test::Legacy
1732 emulates the Test.pm interface and does play well with others.
1734 L<Test::Differences> for more ways to test complex data structures.
1735 And it plays well with Test::More.
1737 L<Test::Class> is like xUnit but more perlish.
1739 L<Test::Deep> gives you more powerful complex data structure testing.
1741 L<Test::Inline> shows the idea of embedded testing.
1743 L<Bundle::Test> installs a whole bunch of useful test modules.
1748 Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
1749 from Joshua Pritikin's Test module and lots of help from Barrie
1750 Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and
1756 See F<http://rt.cpan.org> to report and view bugs.
1761 The source code repository for Test::More can be found at
1762 F<http://github.com/schwern/test-more/>.
1767 Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1769 This program is free software; you can redistribute it and/or
1770 modify it under the same terms as Perl itself.
1772 See F<http://www.perl.com/perl/misc/Artistic.html>