| package Test::More; |
| |
| use 5.006; |
| use strict; |
| use warnings; |
| |
| #---- perlcritic exemptions. ----# |
| |
| # We use a lot of subroutine prototypes |
| ## no critic (Subroutines::ProhibitSubroutinePrototypes) |
| |
| # Can't use Carp because it might cause use_ok() to accidentally succeed |
| # even though the module being used forgot to use Carp. Yes, this |
| # actually happened. |
| sub _carp { |
| my( $file, $line ) = ( caller(1) )[ 1, 2 ]; |
| return warn @_, " at $file line $line\n"; |
| } |
| |
| our $VERSION = '0.98'; |
| $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) |
| |
| use Test::Builder::Module; |
| our @ISA = qw(Test::Builder::Module); |
| our @EXPORT = qw(ok use_ok require_ok |
| is isnt like unlike is_deeply |
| cmp_ok |
| skip todo todo_skip |
| pass fail |
| eq_array eq_hash eq_set |
| $TODO |
| plan |
| done_testing |
| can_ok isa_ok new_ok |
| diag note explain |
| subtest |
| BAIL_OUT |
| ); |
| |
| =head1 NAME |
| |
| Test::More - yet another framework for writing test scripts |
| |
| =head1 SYNOPSIS |
| |
| use Test::More tests => 23; |
| # or |
| use Test::More skip_all => $reason; |
| # or |
| use Test::More; # see done_testing() |
| |
| BEGIN { use_ok( 'Some::Module' ); } |
| require_ok( 'Some::Module' ); |
| |
| # Various ways to say "ok" |
| ok($got eq $expected, $test_name); |
| |
| is ($got, $expected, $test_name); |
| isnt($got, $expected, $test_name); |
| |
| # Rather than print STDERR "# here's what went wrong\n" |
| diag("here's what went wrong"); |
| |
| like ($got, qr/expected/, $test_name); |
| unlike($got, qr/expected/, $test_name); |
| |
| cmp_ok($got, '==', $expected, $test_name); |
| |
| is_deeply($got_complex_structure, $expected_complex_structure, $test_name); |
| |
| SKIP: { |
| skip $why, $how_many unless $have_some_feature; |
| |
| ok( foo(), $test_name ); |
| is( foo(42), 23, $test_name ); |
| }; |
| |
| TODO: { |
| local $TODO = $why; |
| |
| ok( foo(), $test_name ); |
| is( foo(42), 23, $test_name ); |
| }; |
| |
| can_ok($module, @methods); |
| isa_ok($object, $class); |
| |
| pass($test_name); |
| fail($test_name); |
| |
| BAIL_OUT($why); |
| |
| # UNIMPLEMENTED!!! |
| my @status = Test::More::status; |
| |
| |
| =head1 DESCRIPTION |
| |
| B<STOP!> If you're just getting started writing tests, have a look at |
| L<Test::Simple> first. This is a drop in replacement for Test::Simple |
| which you can switch to once you get the hang of basic testing. |
| |
| The purpose of this module is to provide a wide range of testing |
| utilities. Various ways to say "ok" with better diagnostics, |
| facilities to skip tests, test future features and compare complicated |
| data structures. While you can do almost anything with a simple |
| C<ok()> function, it doesn't provide good diagnostic output. |
| |
| |
| =head2 I love it when a plan comes together |
| |
| Before anything else, you need a testing plan. This basically declares |
| how many tests your script is going to run to protect against premature |
| failure. |
| |
| The preferred way to do this is to declare a plan when you C<use Test::More>. |
| |
| use Test::More tests => 23; |
| |
| There are cases when you will not know beforehand how many tests your |
| script is going to run. In this case, you can declare your tests at |
| the end. |
| |
| use Test::More; |
| |
| ... run your tests ... |
| |
| done_testing( $number_of_tests_run ); |
| |
| Sometimes you really don't know how many tests were run, or it's too |
| difficult to calculate. In which case you can leave off |
| $number_of_tests_run. |
| |
| In some cases, you'll want to completely skip an entire testing script. |
| |
| use Test::More skip_all => $skip_reason; |
| |
| Your script will declare a skip with the reason why you skipped and |
| exit immediately with a zero (success). See L<Test::Harness> for |
| details. |
| |
| If you want to control what functions Test::More will export, you |
| have to use the 'import' option. For example, to import everything |
| but 'fail', you'd do: |
| |
| use Test::More tests => 23, import => ['!fail']; |
| |
| Alternatively, you can use the plan() function. Useful for when you |
| have to calculate the number of tests. |
| |
| use Test::More; |
| plan tests => keys %Stuff * 3; |
| |
| or for deciding between running the tests at all: |
| |
| use Test::More; |
| if( $^O eq 'MacOS' ) { |
| plan skip_all => 'Test irrelevant on MacOS'; |
| } |
| else { |
| plan tests => 42; |
| } |
| |
| =cut |
| |
| sub plan { |
| my $tb = Test::More->builder; |
| |
| return $tb->plan(@_); |
| } |
| |
| # This implements "use Test::More 'no_diag'" but the behavior is |
| # deprecated. |
| sub import_extra { |
| my $class = shift; |
| my $list = shift; |
| |
| my @other = (); |
| my $idx = 0; |
| while( $idx <= $#{$list} ) { |
| my $item = $list->[$idx]; |
| |
| if( defined $item and $item eq 'no_diag' ) { |
| $class->builder->no_diag(1); |
| } |
| else { |
| push @other, $item; |
| } |
| |
| $idx++; |
| } |
| |
| @$list = @other; |
| |
| return; |
| } |
| |
| =over 4 |
| |
| =item B<done_testing> |
| |
| done_testing(); |
| done_testing($number_of_tests); |
| |
| If you don't know how many tests you're going to run, you can issue |
| the plan when you're done running tests. |
| |
| $number_of_tests is the same as plan(), it's the number of tests you |
| expected to run. You can omit this, in which case the number of tests |
| you ran doesn't matter, just the fact that your tests ran to |
| conclusion. |
| |
| This is safer than and replaces the "no_plan" plan. |
| |
| =back |
| |
| =cut |
| |
| sub done_testing { |
| my $tb = Test::More->builder; |
| $tb->done_testing(@_); |
| } |
| |
| =head2 Test names |
| |
| By convention, each test is assigned a number in order. This is |
| largely done automatically for you. However, it's often very useful to |
| assign a name to each test. Which would you rather see: |
| |
| ok 4 |
| not ok 5 |
| ok 6 |
| |
| or |
| |
| ok 4 - basic multi-variable |
| not ok 5 - simple exponential |
| ok 6 - force == mass * acceleration |
| |
| The later gives you some idea of what failed. It also makes it easier |
| to find the test in your script, simply search for "simple |
| exponential". |
| |
| All test functions take a name argument. It's optional, but highly |
| suggested that you use it. |
| |
| =head2 I'm ok, you're not ok. |
| |
| The basic purpose of this module is to print out either "ok #" or "not |
| ok #" depending on if a given test succeeded or failed. Everything |
| else is just gravy. |
| |
| All of the following print "ok" or "not ok" depending on if the test |
| succeeded or failed. They all also return true or false, |
| respectively. |
| |
| =over 4 |
| |
| =item B<ok> |
| |
| ok($got eq $expected, $test_name); |
| |
| This simply evaluates any expression (C<$got eq $expected> is just a |
| simple example) and uses that to determine if the test succeeded or |
| failed. A true expression passes, a false one fails. Very simple. |
| |
| For example: |
| |
| ok( $exp{9} == 81, 'simple exponential' ); |
| ok( Film->can('db_Main'), 'set_db()' ); |
| ok( $p->tests == 4, 'saw tests' ); |
| ok( !grep !defined $_, @items, 'items populated' ); |
| |
| (Mnemonic: "This is ok.") |
| |
| $test_name is a very short description of the test that will be printed |
| out. It makes it very easy to find a test in your script when it fails |
| and gives others an idea of your intentions. $test_name is optional, |
| but we B<very> strongly encourage its use. |
| |
| Should an ok() fail, it will produce some diagnostics: |
| |
| not ok 18 - sufficient mucus |
| # Failed test 'sufficient mucus' |
| # in foo.t at line 42. |
| |
| This is the same as Test::Simple's ok() routine. |
| |
| =cut |
| |
| sub ok ($;$) { |
| my( $test, $name ) = @_; |
| my $tb = Test::More->builder; |
| |
| return $tb->ok( $test, $name ); |
| } |
| |
| =item B<is> |
| |
| =item B<isnt> |
| |
| is ( $got, $expected, $test_name ); |
| isnt( $got, $expected, $test_name ); |
| |
| Similar to ok(), is() and isnt() compare their two arguments |
| with C<eq> and C<ne> respectively and use the result of that to |
| determine if the test succeeded or failed. So these: |
| |
| # Is the ultimate answer 42? |
| is( ultimate_answer(), 42, "Meaning of Life" ); |
| |
| # $foo isn't empty |
| isnt( $foo, '', "Got some foo" ); |
| |
| are similar to these: |
| |
| ok( ultimate_answer() eq 42, "Meaning of Life" ); |
| ok( $foo ne '', "Got some foo" ); |
| |
| C<undef> will only ever match C<undef>. So you can test a value |
| agains C<undef> like this: |
| |
| is($not_defined, undef, "undefined as expected"); |
| |
| (Mnemonic: "This is that." "This isn't that.") |
| |
| So why use these? They produce better diagnostics on failure. ok() |
| cannot know what you are testing for (beyond the name), but is() and |
| isnt() know what the test was and why it failed. For example this |
| test: |
| |
| my $foo = 'waffle'; my $bar = 'yarblokos'; |
| is( $foo, $bar, 'Is foo the same as bar?' ); |
| |
| Will produce something like this: |
| |
| not ok 17 - Is foo the same as bar? |
| # Failed test 'Is foo the same as bar?' |
| # in foo.t at line 139. |
| # got: 'waffle' |
| # expected: 'yarblokos' |
| |
| So you can figure out what went wrong without rerunning the test. |
| |
| You are encouraged to use is() and isnt() over ok() where possible, |
| however do not be tempted to use them to find out if something is |
| true or false! |
| |
| # XXX BAD! |
| is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' ); |
| |
| This does not check if C<exists $brooklyn{tree}> is true, it checks if |
| it returns 1. Very different. Similar caveats exist for false and 0. |
| In these cases, use ok(). |
| |
| ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' ); |
| |
| A simple call to isnt() usually does not provide a strong test but there |
| are cases when you cannot say much more about a value than that it is |
| different from some other value: |
| |
| new_ok $obj, "Foo"; |
| |
| my $clone = $obj->clone; |
| isa_ok $obj, "Foo", "Foo->clone"; |
| |
| isnt $obj, $clone, "clone() produces a different object"; |
| |
| For those grammatical pedants out there, there's an C<isn't()> |
| function which is an alias of isnt(). |
| |
| =cut |
| |
| sub is ($$;$) { |
| my $tb = Test::More->builder; |
| |
| return $tb->is_eq(@_); |
| } |
| |
| sub isnt ($$;$) { |
| my $tb = Test::More->builder; |
| |
| return $tb->isnt_eq(@_); |
| } |
| |
| *isn't = \&isnt; |
| |
| =item B<like> |
| |
| like( $got, qr/expected/, $test_name ); |
| |
| Similar to ok(), like() matches $got against the regex C<qr/expected/>. |
| |
| So this: |
| |
| like($got, qr/expected/, 'this is like that'); |
| |
| is similar to: |
| |
| ok( $got =~ /expected/, 'this is like that'); |
| |
| (Mnemonic "This is like that".) |
| |
| The second argument is a regular expression. It may be given as a |
| regex reference (i.e. C<qr//>) or (for better compatibility with older |
| perls) as a string that looks like a regex (alternative delimiters are |
| currently not supported): |
| |
| like( $got, '/expected/', 'this is like that' ); |
| |
| Regex options may be placed on the end (C<'/expected/i'>). |
| |
| Its advantages over ok() are similar to that of is() and isnt(). Better |
| diagnostics on failure. |
| |
| =cut |
| |
| sub like ($$;$) { |
| my $tb = Test::More->builder; |
| |
| return $tb->like(@_); |
| } |
| |
| =item B<unlike> |
| |
| unlike( $got, qr/expected/, $test_name ); |
| |
| Works exactly as like(), only it checks if $got B<does not> match the |
| given pattern. |
| |
| =cut |
| |
| sub unlike ($$;$) { |
| my $tb = Test::More->builder; |
| |
| return $tb->unlike(@_); |
| } |
| |
| =item B<cmp_ok> |
| |
| cmp_ok( $got, $op, $expected, $test_name ); |
| |
| Halfway between ok() and is() lies cmp_ok(). This allows you to |
| compare two arguments using any binary perl operator. |
| |
| # ok( $got eq $expected ); |
| cmp_ok( $got, 'eq', $expected, 'this eq that' ); |
| |
| # ok( $got == $expected ); |
| cmp_ok( $got, '==', $expected, 'this == that' ); |
| |
| # ok( $got && $expected ); |
| cmp_ok( $got, '&&', $expected, 'this && that' ); |
| ...etc... |
| |
| Its advantage over ok() is when the test fails you'll know what $got |
| and $expected were: |
| |
| not ok 1 |
| # Failed test in foo.t at line 12. |
| # '23' |
| # && |
| # undef |
| |
| It's also useful in those cases where you are comparing numbers and |
| is()'s use of C<eq> will interfere: |
| |
| cmp_ok( $big_hairy_number, '==', $another_big_hairy_number ); |
| |
| It's especially useful when comparing greater-than or smaller-than |
| relation between values: |
| |
| cmp_ok( $some_value, '<=', $upper_limit ); |
| |
| |
| =cut |
| |
| sub cmp_ok($$$;$) { |
| my $tb = Test::More->builder; |
| |
| return $tb->cmp_ok(@_); |
| } |
| |
| =item B<can_ok> |
| |
| can_ok($module, @methods); |
| can_ok($object, @methods); |
| |
| Checks to make sure the $module or $object can do these @methods |
| (works with functions, too). |
| |
| can_ok('Foo', qw(this that whatever)); |
| |
| is almost exactly like saying: |
| |
| ok( Foo->can('this') && |
| Foo->can('that') && |
| Foo->can('whatever') |
| ); |
| |
| only without all the typing and with a better interface. Handy for |
| quickly testing an interface. |
| |
| No matter how many @methods you check, a single can_ok() call counts |
| as one test. If you desire otherwise, use: |
| |
| foreach my $meth (@methods) { |
| can_ok('Foo', $meth); |
| } |
| |
| =cut |
| |
| sub can_ok ($@) { |
| my( $proto, @methods ) = @_; |
| my $class = ref $proto || $proto; |
| my $tb = Test::More->builder; |
| |
| unless($class) { |
| my $ok = $tb->ok( 0, "->can(...)" ); |
| $tb->diag(' can_ok() called with empty class or reference'); |
| return $ok; |
| } |
| |
| unless(@methods) { |
| my $ok = $tb->ok( 0, "$class->can(...)" ); |
| $tb->diag(' can_ok() called with no methods'); |
| return $ok; |
| } |
| |
| my @nok = (); |
| foreach my $method (@methods) { |
| $tb->_try( sub { $proto->can($method) } ) or push @nok, $method; |
| } |
| |
| my $name = (@methods == 1) ? "$class->can('$methods[0]')" : |
| "$class->can(...)" ; |
| |
| my $ok = $tb->ok( !@nok, $name ); |
| |
| $tb->diag( map " $class->can('$_') failed\n", @nok ); |
| |
| return $ok; |
| } |
| |
| =item B<isa_ok> |
| |
| isa_ok($object, $class, $object_name); |
| isa_ok($subclass, $class, $object_name); |
| isa_ok($ref, $type, $ref_name); |
| |
| Checks to see if the given C<< $object->isa($class) >>. Also checks to make |
| sure the object was defined in the first place. Handy for this sort |
| of thing: |
| |
| my $obj = Some::Module->new; |
| isa_ok( $obj, 'Some::Module' ); |
| |
| where you'd otherwise have to write |
| |
| my $obj = Some::Module->new; |
| ok( defined $obj && $obj->isa('Some::Module') ); |
| |
| to safeguard against your test script blowing up. |
| |
| You can also test a class, to make sure that it has the right ancestor: |
| |
| isa_ok( 'Vole', 'Rodent' ); |
| |
| It works on references, too: |
| |
| isa_ok( $array_ref, 'ARRAY' ); |
| |
| The diagnostics of this test normally just refer to 'the object'. If |
| you'd like them to be more specific, you can supply an $object_name |
| (for example 'Test customer'). |
| |
| =cut |
| |
| sub isa_ok ($$;$) { |
| my( $object, $class, $obj_name ) = @_; |
| my $tb = Test::More->builder; |
| |
| my $diag; |
| |
| if( !defined $object ) { |
| $obj_name = 'The thing' unless defined $obj_name; |
| $diag = "$obj_name isn't defined"; |
| } |
| else { |
| my $whatami = ref $object ? 'object' : 'class'; |
| # We can't use UNIVERSAL::isa because we want to honor isa() overrides |
| my( $rslt, $error ) = $tb->_try( sub { $object->isa($class) } ); |
| if($error) { |
| if( $error =~ /^Can't call method "isa" on unblessed reference/ ) { |
| # Its an unblessed reference |
| $obj_name = 'The reference' unless defined $obj_name; |
| if( !UNIVERSAL::isa( $object, $class ) ) { |
| my $ref = ref $object; |
| $diag = "$obj_name isn't a '$class' it's a '$ref'"; |
| } |
| } |
| elsif( $error =~ /Can't call method "isa" without a package/ ) { |
| # It's something that can't even be a class |
| $obj_name = 'The thing' unless defined $obj_name; |
| $diag = "$obj_name isn't a class or reference"; |
| } |
| else { |
| die <<WHOA; |
| WHOA! I tried to call ->isa on your $whatami and got some weird error. |
| Here's the error. |
| $error |
| WHOA |
| } |
| } |
| else { |
| $obj_name = "The $whatami" unless defined $obj_name; |
| if( !$rslt ) { |
| my $ref = ref $object; |
| $diag = "$obj_name isn't a '$class' it's a '$ref'"; |
| } |
| } |
| } |
| |
| my $name = "$obj_name isa $class"; |
| my $ok; |
| if($diag) { |
| $ok = $tb->ok( 0, $name ); |
| $tb->diag(" $diag\n"); |
| } |
| else { |
| $ok = $tb->ok( 1, $name ); |
| } |
| |
| return $ok; |
| } |
| |
| =item B<new_ok> |
| |
| my $obj = new_ok( $class ); |
| my $obj = new_ok( $class => \@args ); |
| my $obj = new_ok( $class => \@args, $object_name ); |
| |
| A convenience function which combines creating an object and calling |
| isa_ok() on that object. |
| |
| It is basically equivalent to: |
| |
| my $obj = $class->new(@args); |
| isa_ok $obj, $class, $object_name; |
| |
| If @args is not given, an empty list will be used. |
| |
| This function only works on new() and it assumes new() will return |
| just a single object which isa C<$class>. |
| |
| =cut |
| |
| sub new_ok { |
| my $tb = Test::More->builder; |
| $tb->croak("new_ok() must be given at least a class") unless @_; |
| |
| my( $class, $args, $object_name ) = @_; |
| |
| $args ||= []; |
| $object_name = "The object" unless defined $object_name; |
| |
| my $obj; |
| my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } ); |
| if($success) { |
| local $Test::Builder::Level = $Test::Builder::Level + 1; |
| isa_ok $obj, $class, $object_name; |
| } |
| else { |
| $tb->ok( 0, "new() died" ); |
| $tb->diag(" Error was: $error"); |
| } |
| |
| return $obj; |
| } |
| |
| =item B<subtest> |
| |
| subtest $name => \&code; |
| |
| subtest() runs the &code as its own little test with its own plan and |
| its own result. The main test counts this as a single test using the |
| result of the whole subtest to determine if its ok or not ok. |
| |
| For example... |
| |
| use Test::More tests => 3; |
| |
| pass("First test"); |
| |
| subtest 'An example subtest' => sub { |
| plan tests => 2; |
| |
| pass("This is a subtest"); |
| pass("So is this"); |
| }; |
| |
| pass("Third test"); |
| |
| This would produce. |
| |
| 1..3 |
| ok 1 - First test |
| 1..2 |
| ok 1 - This is a subtest |
| ok 2 - So is this |
| ok 2 - An example subtest |
| ok 3 - Third test |
| |
| A subtest may call "skip_all". No tests will be run, but the subtest is |
| considered a skip. |
| |
| subtest 'skippy' => sub { |
| plan skip_all => 'cuz I said so'; |
| pass('this test will never be run'); |
| }; |
| |
| Returns true if the subtest passed, false otherwise. |
| |
| Due to how subtests work, you may omit a plan if you desire. This adds an |
| implicit C<done_testing()> to the end of your subtest. The following two |
| subtests are equivalent: |
| |
| subtest 'subtest with implicit done_testing()', sub { |
| ok 1, 'subtests with an implicit done testing should work'; |
| ok 1, '... and support more than one test'; |
| ok 1, '... no matter how many tests are run'; |
| }; |
| |
| subtest 'subtest with explicit done_testing()', sub { |
| ok 1, 'subtests with an explicit done testing should work'; |
| ok 1, '... and support more than one test'; |
| ok 1, '... no matter how many tests are run'; |
| done_testing(); |
| }; |
| |
| =cut |
| |
| sub subtest { |
| my ($name, $subtests) = @_; |
| |
| my $tb = Test::More->builder; |
| return $tb->subtest(@_); |
| } |
| |
| =item B<pass> |
| |
| =item B<fail> |
| |
| pass($test_name); |
| fail($test_name); |
| |
| Sometimes you just want to say that the tests have passed. Usually |
| the case is you've got some complicated condition that is difficult to |
| wedge into an ok(). In this case, you can simply use pass() (to |
| declare the test ok) or fail (for not ok). They are synonyms for |
| ok(1) and ok(0). |
| |
| Use these very, very, very sparingly. |
| |
| =cut |
| |
| sub pass (;$) { |
| my $tb = Test::More->builder; |
| |
| return $tb->ok( 1, @_ ); |
| } |
| |
| sub fail (;$) { |
| my $tb = Test::More->builder; |
| |
| return $tb->ok( 0, @_ ); |
| } |
| |
| =back |
| |
| |
| =head2 Module tests |
| |
| You usually want to test if the module you're testing loads ok, rather |
| than just vomiting if its load fails. For such purposes we have |
| C<use_ok> and C<require_ok>. |
| |
| =over 4 |
| |
| =item B<use_ok> |
| |
| BEGIN { use_ok($module); } |
| BEGIN { use_ok($module, @imports); } |
| |
| These simply use the given $module and test to make sure the load |
| happened ok. It's recommended that you run use_ok() inside a BEGIN |
| block so its functions are exported at compile-time and prototypes are |
| properly honored. |
| |
| If @imports are given, they are passed through to the use. So this: |
| |
| BEGIN { use_ok('Some::Module', qw(foo bar)) } |
| |
| is like doing this: |
| |
| use Some::Module qw(foo bar); |
| |
| Version numbers can be checked like so: |
| |
| # Just like "use Some::Module 1.02" |
| BEGIN { use_ok('Some::Module', 1.02) } |
| |
| Don't try to do this: |
| |
| BEGIN { |
| use_ok('Some::Module'); |
| |
| ...some code that depends on the use... |
| ...happening at compile time... |
| } |
| |
| because the notion of "compile-time" is relative. Instead, you want: |
| |
| BEGIN { use_ok('Some::Module') } |
| BEGIN { ...some code that depends on the use... } |
| |
| If you want the equivalent of C<use Foo ()>, use a module but not |
| import anything, use C<require_ok>. |
| |
| BEGIN { require_ok "Foo" } |
| |
| |
| =cut |
| |
| sub use_ok ($;@) { |
| my( $module, @imports ) = @_; |
| @imports = () unless @imports; |
| my $tb = Test::More->builder; |
| |
| my( $pack, $filename, $line ) = caller; |
| |
| my $code; |
| if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) { |
| # probably a version check. Perl needs to see the bare number |
| # for it to work with non-Exporter based modules. |
| $code = <<USE; |
| package $pack; |
| use $module $imports[0]; |
| 1; |
| USE |
| } |
| else { |
| $code = <<USE; |
| package $pack; |
| use $module \@{\$args[0]}; |
| 1; |
| USE |
| } |
| |
| my( $eval_result, $eval_error ) = _eval( $code, \@imports ); |
| my $ok = $tb->ok( $eval_result, "use $module;" ); |
| |
| unless($ok) { |
| chomp $eval_error; |
| $@ =~ s{^BEGIN failed--compilation aborted at .*$} |
| {BEGIN failed--compilation aborted at $filename line $line.}m; |
| $tb->diag(<<DIAGNOSTIC); |
| Tried to use '$module'. |
| Error: $eval_error |
| DIAGNOSTIC |
| |
| } |
| |
| return $ok; |
| } |
| |
| sub _eval { |
| my( $code, @args ) = @_; |
| |
| # Work around oddities surrounding resetting of $@ by immediately |
| # storing it. |
| my( $sigdie, $eval_result, $eval_error ); |
| { |
| local( $@, $!, $SIG{__DIE__} ); # isolate eval |
| $eval_result = eval $code; ## no critic (BuiltinFunctions::ProhibitStringyEval) |
| $eval_error = $@; |
| $sigdie = $SIG{__DIE__} || undef; |
| } |
| # make sure that $code got a chance to set $SIG{__DIE__} |
| $SIG{__DIE__} = $sigdie if defined $sigdie; |
| |
| return( $eval_result, $eval_error ); |
| } |
| |
| =item B<require_ok> |
| |
| require_ok($module); |
| require_ok($file); |
| |
| Like use_ok(), except it requires the $module or $file. |
| |
| =cut |
| |
| sub require_ok ($) { |
| my($module) = shift; |
| my $tb = Test::More->builder; |
| |
| my $pack = caller; |
| |
| # Try to determine if we've been given a module name or file. |
| # Module names must be barewords, files not. |
| $module = qq['$module'] unless _is_module_name($module); |
| |
| my $code = <<REQUIRE; |
| package $pack; |
| require $module; |
| 1; |
| REQUIRE |
| |
| my( $eval_result, $eval_error ) = _eval($code); |
| my $ok = $tb->ok( $eval_result, "require $module;" ); |
| |
| unless($ok) { |
| chomp $eval_error; |
| $tb->diag(<<DIAGNOSTIC); |
| Tried to require '$module'. |
| Error: $eval_error |
| DIAGNOSTIC |
| |
| } |
| |
| return $ok; |
| } |
| |
| sub _is_module_name { |
| my $module = shift; |
| |
| # Module names start with a letter. |
| # End with an alphanumeric. |
| # The rest is an alphanumeric or :: |
| $module =~ s/\b::\b//g; |
| |
| return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0; |
| } |
| |
| =back |
| |
| |
| =head2 Complex data structures |
| |
| Not everything is a simple eq check or regex. There are times you |
| need to see if two data structures are equivalent. For these |
| instances Test::More provides a handful of useful functions. |
| |
| B<NOTE> I'm not quite sure what will happen with filehandles. |
| |
| =over 4 |
| |
| =item B<is_deeply> |
| |
| is_deeply( $got, $expected, $test_name ); |
| |
| Similar to is(), except that if $got and $expected are references, it |
| does a deep comparison walking each data structure to see if they are |
| equivalent. If the two structures are different, it will display the |
| place where they start differing. |
| |
| is_deeply() compares the dereferenced values of references, the |
| references themselves (except for their type) are ignored. This means |
| aspects such as blessing and ties are not considered "different". |
| |
| is_deeply() currently has very limited handling of function reference |
| and globs. It merely checks if they have the same referent. This may |
| improve in the future. |
| |
| L<Test::Differences> and L<Test::Deep> provide more in-depth functionality |
| along these lines. |
| |
| =cut |
| |
| our( @Data_Stack, %Refs_Seen ); |
| my $DNE = bless [], 'Does::Not::Exist'; |
| |
| sub _dne { |
| return ref $_[0] eq ref $DNE; |
| } |
| |
| ## no critic (Subroutines::RequireArgUnpacking) |
| sub is_deeply { |
| my $tb = Test::More->builder; |
| |
| unless( @_ == 2 or @_ == 3 ) { |
| my $msg = <<'WARNING'; |
| is_deeply() takes two or three args, you gave %d. |
| This usually means you passed an array or hash instead |
| of a reference to it |
| WARNING |
| chop $msg; # clip off newline so carp() will put in line/file |
| |
| _carp sprintf $msg, scalar @_; |
| |
| return $tb->ok(0); |
| } |
| |
| my( $got, $expected, $name ) = @_; |
| |
| $tb->_unoverload_str( \$expected, \$got ); |
| |
| my $ok; |
| if( !ref $got and !ref $expected ) { # neither is a reference |
| $ok = $tb->is_eq( $got, $expected, $name ); |
| } |
| elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't |
| $ok = $tb->ok( 0, $name ); |
| $tb->diag( _format_stack({ vals => [ $got, $expected ] }) ); |
| } |
| else { # both references |
| local @Data_Stack = (); |
| if( _deep_check( $got, $expected ) ) { |
| $ok = $tb->ok( 1, $name ); |
| } |
| else { |
| $ok = $tb->ok( 0, $name ); |
| $tb->diag( _format_stack(@Data_Stack) ); |
| } |
| } |
| |
| return $ok; |
| } |
| |
| sub _format_stack { |
| my(@Stack) = @_; |
| |
| my $var = '$FOO'; |
| my $did_arrow = 0; |
| foreach my $entry (@Stack) { |
| my $type = $entry->{type} || ''; |
| my $idx = $entry->{'idx'}; |
| if( $type eq 'HASH' ) { |
| $var .= "->" unless $did_arrow++; |
| $var .= "{$idx}"; |
| } |
| elsif( $type eq 'ARRAY' ) { |
| $var .= "->" unless $did_arrow++; |
| $var .= "[$idx]"; |
| } |
| elsif( $type eq 'REF' ) { |
| $var = "\${$var}"; |
| } |
| } |
| |
| my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ]; |
| my @vars = (); |
| ( $vars[0] = $var ) =~ s/\$FOO/ \$got/; |
| ( $vars[1] = $var ) =~ s/\$FOO/\$expected/; |
| |
| my $out = "Structures begin differing at:\n"; |
| foreach my $idx ( 0 .. $#vals ) { |
| my $val = $vals[$idx]; |
| $vals[$idx] |
| = !defined $val ? 'undef' |
| : _dne($val) ? "Does not exist" |
| : ref $val ? "$val" |
| : "'$val'"; |
| } |
| |
| $out .= "$vars[0] = $vals[0]\n"; |
| $out .= "$vars[1] = $vals[1]\n"; |
| |
| $out =~ s/^/ /msg; |
| return $out; |
| } |
| |
| sub _type { |
| my $thing = shift; |
| |
| return '' if !ref $thing; |
| |
| for my $type (qw(Regexp ARRAY HASH REF SCALAR GLOB CODE)) { |
| return $type if UNIVERSAL::isa( $thing, $type ); |
| } |
| |
| return ''; |
| } |
| |
| =back |
| |
| |
| =head2 Diagnostics |
| |
| If you pick the right test function, you'll usually get a good idea of |
| what went wrong when it failed. But sometimes it doesn't work out |
| that way. So here we have ways for you to write your own diagnostic |
| messages which are safer than just C<print STDERR>. |
| |
| =over 4 |
| |
| =item B<diag> |
| |
| diag(@diagnostic_message); |
| |
| Prints a diagnostic message which is guaranteed not to interfere with |
| test output. Like C<print> @diagnostic_message is simply concatenated |
| together. |
| |
| Returns false, so as to preserve failure. |
| |
| Handy for this sort of thing: |
| |
| ok( grep(/foo/, @users), "There's a foo user" ) or |
| diag("Since there's no foo, check that /etc/bar is set up right"); |
| |
| which would produce: |
| |
| not ok 42 - There's a foo user |
| # Failed test 'There's a foo user' |
| # in foo.t at line 52. |
| # Since there's no foo, check that /etc/bar is set up right. |
| |
| You might remember C<ok() or diag()> with the mnemonic C<open() or |
| die()>. |
| |
| B<NOTE> The exact formatting of the diagnostic output is still |
| changing, but it is guaranteed that whatever you throw at it it won't |
| interfere with the test. |
| |
| =item B<note> |
| |
| note(@diagnostic_message); |
| |
| Like diag(), except the message will not be seen when the test is run |
| in a harness. It will only be visible in the verbose TAP stream. |
| |
| Handy for putting in notes which might be useful for debugging, but |
| don't indicate a problem. |
| |
| note("Tempfile is $tempfile"); |
| |
| =cut |
| |
| sub diag { |
| return Test::More->builder->diag(@_); |
| } |
| |
| sub note { |
| return Test::More->builder->note(@_); |
| } |
| |
| =item B<explain> |
| |
| my @dump = explain @diagnostic_message; |
| |
| Will dump the contents of any references in a human readable format. |
| Usually you want to pass this into C<note> or C<diag>. |
| |
| Handy for things like... |
| |
| is_deeply($have, $want) || diag explain $have; |
| |
| or |
| |
| note explain \%args; |
| Some::Class->method(%args); |
| |
| =cut |
| |
| sub explain { |
| return Test::More->builder->explain(@_); |
| } |
| |
| =back |
| |
| |
| =head2 Conditional tests |
| |
| Sometimes running a test under certain conditions will cause the |
| test script to die. A certain function or method isn't implemented |
| (such as fork() on MacOS), some resource isn't available (like a |
| net connection) or a module isn't available. In these cases it's |
| necessary to skip tests, or declare that they are supposed to fail |
| but will work in the future (a todo test). |
| |
| For more details on the mechanics of skip and todo tests see |
| L<Test::Harness>. |
| |
| The way Test::More handles this is with a named block. Basically, a |
| block of tests which can be skipped over or made todo. It's best if I |
| just show you... |
| |
| =over 4 |
| |
| =item B<SKIP: BLOCK> |
| |
| SKIP: { |
| skip $why, $how_many if $condition; |
| |
| ...normal testing code goes here... |
| } |
| |
| This declares a block of tests that might be skipped, $how_many tests |
| there are, $why and under what $condition to skip them. An example is |
| the easiest way to illustrate: |
| |
| SKIP: { |
| eval { require HTML::Lint }; |
| |
| skip "HTML::Lint not installed", 2 if $@; |
| |
| my $lint = new HTML::Lint; |
| isa_ok( $lint, "HTML::Lint" ); |
| |
| $lint->parse( $html ); |
| is( $lint->errors, 0, "No errors found in HTML" ); |
| } |
| |
| If the user does not have HTML::Lint installed, the whole block of |
| code I<won't be run at all>. Test::More will output special ok's |
| which Test::Harness interprets as skipped, but passing, tests. |
| |
| It's important that $how_many accurately reflects the number of tests |
| in the SKIP block so the # of tests run will match up with your plan. |
| If your plan is C<no_plan> $how_many is optional and will default to 1. |
| |
| It's perfectly safe to nest SKIP blocks. Each SKIP block must have |
| the label C<SKIP>, or Test::More can't work its magic. |
| |
| You don't skip tests which are failing because there's a bug in your |
| program, or for which you don't yet have code written. For that you |
| use TODO. Read on. |
| |
| =cut |
| |
| ## no critic (Subroutines::RequireFinalReturn) |
| sub skip { |
| my( $why, $how_many ) = @_; |
| my $tb = Test::More->builder; |
| |
| unless( defined $how_many ) { |
| # $how_many can only be avoided when no_plan is in use. |
| _carp "skip() needs to know \$how_many tests are in the block" |
| unless $tb->has_plan eq 'no_plan'; |
| $how_many = 1; |
| } |
| |
| if( defined $how_many and $how_many =~ /\D/ ) { |
| _carp |
| "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?"; |
| $how_many = 1; |
| } |
| |
| for( 1 .. $how_many ) { |
| $tb->skip($why); |
| } |
| |
| no warnings 'exiting'; |
| last SKIP; |
| } |
| |
| =item B<TODO: BLOCK> |
| |
| TODO: { |
| local $TODO = $why if $condition; |
| |
| ...normal testing code goes here... |
| } |
| |
| Declares a block of tests you expect to fail and $why. Perhaps it's |
| because you haven't fixed a bug or haven't finished a new feature: |
| |
| TODO: { |
| local $TODO = "URI::Geller not finished"; |
| |
| my $card = "Eight of clubs"; |
| is( URI::Geller->your_card, $card, 'Is THIS your card?' ); |
| |
| my $spoon; |
| URI::Geller->bend_spoon; |
| is( $spoon, 'bent', "Spoon bending, that's original" ); |
| } |
| |
| With a todo block, the tests inside are expected to fail. Test::More |
| will run the tests normally, but print out special flags indicating |
| they are "todo". Test::Harness will interpret failures as being ok. |
| Should anything succeed, it will report it as an unexpected success. |
| You then know the thing you had todo is done and can remove the |
| TODO flag. |
| |
| The nice part about todo tests, as opposed to simply commenting out a |
| block of tests, is it's like having a programmatic todo list. You know |
| how much work is left to be done, you're aware of what bugs there are, |
| and you'll know immediately when they're fixed. |
| |
| Once a todo test starts succeeding, simply move it outside the block. |
| When the block is empty, delete it. |
| |
| |
| =item B<todo_skip> |
| |
| TODO: { |
| todo_skip $why, $how_many if $condition; |
| |
| ...normal testing code... |
| } |
| |
| With todo tests, it's best to have the tests actually run. That way |
| you'll know when they start passing. Sometimes this isn't possible. |
| Often a failing test will cause the whole program to die or hang, even |
| inside an C<eval BLOCK> with and using C<alarm>. In these extreme |
| cases you have no choice but to skip over the broken tests entirely. |
| |
| The syntax and behavior is similar to a C<SKIP: BLOCK> except the |
| tests will be marked as failing but todo. Test::Harness will |
| interpret them as passing. |
| |
| =cut |
| |
| sub todo_skip { |
| my( $why, $how_many ) = @_; |
| my $tb = Test::More->builder; |
| |
| unless( defined $how_many ) { |
| # $how_many can only be avoided when no_plan is in use. |
| _carp "todo_skip() needs to know \$how_many tests are in the block" |
| unless $tb->has_plan eq 'no_plan'; |
| $how_many = 1; |
| } |
| |
| for( 1 .. $how_many ) { |
| $tb->todo_skip($why); |
| } |
| |
| no warnings 'exiting'; |
| last TODO; |
| } |
| |
| =item When do I use SKIP vs. TODO? |
| |
| B<If it's something the user might not be able to do>, use SKIP. |
| This includes optional modules that aren't installed, running under |
| an OS that doesn't have some feature (like fork() or symlinks), or maybe |
| you need an Internet connection and one isn't available. |
| |
| B<If it's something the programmer hasn't done yet>, use TODO. This |
| is for any code you haven't written yet, or bugs you have yet to fix, |
| but want to put tests in your testing script (always a good idea). |
| |
| |
| =back |
| |
| |
| =head2 Test control |
| |
| =over 4 |
| |
| =item B<BAIL_OUT> |
| |
| BAIL_OUT($reason); |
| |
| Indicates to the harness that things are going so badly all testing |
| should terminate. This includes the running of any additional test scripts. |
| |
| This is typically used when testing cannot continue such as a critical |
| module failing to compile or a necessary external utility not being |
| available such as a database connection failing. |
| |
| The test will exit with 255. |
| |
| For even better control look at L<Test::Most>. |
| |
| =cut |
| |
| sub BAIL_OUT { |
| my $reason = shift; |
| my $tb = Test::More->builder; |
| |
| $tb->BAIL_OUT($reason); |
| } |
| |
| =back |
| |
| |
| =head2 Discouraged comparison functions |
| |
| The use of the following functions is discouraged as they are not |
| actually testing functions and produce no diagnostics to help figure |
| out what went wrong. They were written before is_deeply() existed |
| because I couldn't figure out how to display a useful diff of two |
| arbitrary data structures. |
| |
| These functions are usually used inside an ok(). |
| |
| ok( eq_array(\@got, \@expected) ); |
| |
| C<is_deeply()> can do that better and with diagnostics. |
| |
| is_deeply( \@got, \@expected ); |
| |
| They may be deprecated in future versions. |
| |
| =over 4 |
| |
| =item B<eq_array> |
| |
| my $is_eq = eq_array(\@got, \@expected); |
| |
| Checks if two arrays are equivalent. This is a deep check, so |
| multi-level structures are handled correctly. |
| |
| =cut |
| |
| #'# |
| sub eq_array { |
| local @Data_Stack = (); |
| _deep_check(@_); |
| } |
| |
| sub _eq_array { |
| my( $a1, $a2 ) = @_; |
| |
| if( grep _type($_) ne 'ARRAY', $a1, $a2 ) { |
| warn "eq_array passed a non-array ref"; |
| return 0; |
| } |
| |
| return 1 if $a1 eq $a2; |
| |
| my $ok = 1; |
| my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2; |
| for( 0 .. $max ) { |
| my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_]; |
| my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_]; |
| |
| next if _equal_nonrefs($e1, $e2); |
| |
| push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] }; |
| $ok = _deep_check( $e1, $e2 ); |
| pop @Data_Stack if $ok; |
| |
| last unless $ok; |
| } |
| |
| return $ok; |
| } |
| |
| sub _equal_nonrefs { |
| my( $e1, $e2 ) = @_; |
| |
| return if ref $e1 or ref $e2; |
| |
| if ( defined $e1 ) { |
| return 1 if defined $e2 and $e1 eq $e2; |
| } |
| else { |
| return 1 if !defined $e2; |
| } |
| |
| return; |
| } |
| |
| sub _deep_check { |
| my( $e1, $e2 ) = @_; |
| my $tb = Test::More->builder; |
| |
| my $ok = 0; |
| |
| # Effectively turn %Refs_Seen into a stack. This avoids picking up |
| # the same referenced used twice (such as [\$a, \$a]) to be considered |
| # circular. |
| local %Refs_Seen = %Refs_Seen; |
| |
| { |
| $tb->_unoverload_str( \$e1, \$e2 ); |
| |
| # Either they're both references or both not. |
| my $same_ref = !( !ref $e1 xor !ref $e2 ); |
| my $not_ref = ( !ref $e1 and !ref $e2 ); |
| |
| if( defined $e1 xor defined $e2 ) { |
| $ok = 0; |
| } |
| elsif( !defined $e1 and !defined $e2 ) { |
| # Shortcut if they're both undefined. |
| $ok = 1; |
| } |
| elsif( _dne($e1) xor _dne($e2) ) { |
| $ok = 0; |
| } |
| elsif( $same_ref and( $e1 eq $e2 ) ) { |
| $ok = 1; |
| } |
| elsif($not_ref) { |
| push @Data_Stack, { type => '', vals => [ $e1, $e2 ] }; |
| $ok = 0; |
| } |
| else { |
| if( $Refs_Seen{$e1} ) { |
| return $Refs_Seen{$e1} eq $e2; |
| } |
| else { |
| $Refs_Seen{$e1} = "$e2"; |
| } |
| |
| my $type = _type($e1); |
| $type = 'DIFFERENT' unless _type($e2) eq $type; |
| |
| if( $type eq 'DIFFERENT' ) { |
| push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; |
| $ok = 0; |
| } |
| elsif( $type eq 'ARRAY' ) { |
| $ok = _eq_array( $e1, $e2 ); |
| } |
| elsif( $type eq 'HASH' ) { |
| $ok = _eq_hash( $e1, $e2 ); |
| } |
| elsif( $type eq 'REF' ) { |
| push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; |
| $ok = _deep_check( $$e1, $$e2 ); |
| pop @Data_Stack if $ok; |
| } |
| elsif( $type eq 'SCALAR' ) { |
| push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] }; |
| $ok = _deep_check( $$e1, $$e2 ); |
| pop @Data_Stack if $ok; |
| } |
| elsif($type) { |
| push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; |
| $ok = 0; |
| } |
| else { |
| _whoa( 1, "No type in _deep_check" ); |
| } |
| } |
| } |
| |
| return $ok; |
| } |
| |
| sub _whoa { |
| my( $check, $desc ) = @_; |
| if($check) { |
| die <<"WHOA"; |
| WHOA! $desc |
| This should never happen! Please contact the author immediately! |
| WHOA |
| } |
| } |
| |
| =item B<eq_hash> |
| |
| my $is_eq = eq_hash(\%got, \%expected); |
| |
| Determines if the two hashes contain the same keys and values. This |
| is a deep check. |
| |
| =cut |
| |
| sub eq_hash { |
| local @Data_Stack = (); |
| return _deep_check(@_); |
| } |
| |
| sub _eq_hash { |
| my( $a1, $a2 ) = @_; |
| |
| if( grep _type($_) ne 'HASH', $a1, $a2 ) { |
| warn "eq_hash passed a non-hash ref"; |
| return 0; |
| } |
| |
| return 1 if $a1 eq $a2; |
| |
| my $ok = 1; |
| my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2; |
| foreach my $k ( keys %$bigger ) { |
| my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE; |
| my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE; |
| |
| next if _equal_nonrefs($e1, $e2); |
| |
| push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] }; |
| $ok = _deep_check( $e1, $e2 ); |
| pop @Data_Stack if $ok; |
| |
| last unless $ok; |
| } |
| |
| return $ok; |
| } |
| |
| =item B<eq_set> |
| |
| my $is_eq = eq_set(\@got, \@expected); |
| |
| Similar to eq_array(), except the order of the elements is B<not> |
| important. This is a deep check, but the irrelevancy of order only |
| applies to the top level. |
| |
| ok( eq_set(\@got, \@expected) ); |
| |
| Is better written: |
| |
| is_deeply( [sort @got], [sort @expected] ); |
| |
| B<NOTE> By historical accident, this is not a true set comparison. |
| While the order of elements does not matter, duplicate elements do. |
| |
| B<NOTE> eq_set() does not know how to deal with references at the top |
| level. The following is an example of a comparison which might not work: |
| |
| eq_set([\1, \2], [\2, \1]); |
| |
| L<Test::Deep> contains much better set comparison functions. |
| |
| =cut |
| |
| sub eq_set { |
| my( $a1, $a2 ) = @_; |
| return 0 unless @$a1 == @$a2; |
| |
| no warnings 'uninitialized'; |
| |
| # It really doesn't matter how we sort them, as long as both arrays are |
| # sorted with the same algorithm. |
| # |
| # Ensure that references are not accidentally treated the same as a |
| # string containing the reference. |
| # |
| # Have to inline the sort routine due to a threading/sort bug. |
| # See [rt.cpan.org 6782] |
| # |
| # I don't know how references would be sorted so we just don't sort |
| # them. This means eq_set doesn't really work with refs. |
| return eq_array( |
| [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ], |
| [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ], |
| ); |
| } |
| |
| =back |
| |
| |
| =head2 Extending and Embedding Test::More |
| |
| Sometimes the Test::More interface isn't quite enough. Fortunately, |
| Test::More is built on top of Test::Builder which provides a single, |
| unified backend for any test library to use. This means two test |
| libraries which both use Test::Builder B<can be used together in the |
| same program>. |
| |
| If you simply want to do a little tweaking of how the tests behave, |
| you can access the underlying Test::Builder object like so: |
| |
| =over 4 |
| |
| =item B<builder> |
| |
| my $test_builder = Test::More->builder; |
| |
| Returns the Test::Builder object underlying Test::More for you to play |
| with. |
| |
| |
| =back |
| |
| |
| =head1 EXIT CODES |
| |
| If all your tests passed, Test::Builder will exit with zero (which is |
| normal). If anything failed it will exit with how many failed. If |
| you run less (or more) tests than you planned, the missing (or extras) |
| will be considered failures. If no tests were ever run Test::Builder |
| will throw a warning and exit with 255. If the test died, even after |
| having successfully completed all its tests, it will still be |
| considered a failure and will exit with 255. |
| |
| So the exit codes are... |
| |
| 0 all tests successful |
| 255 test died or all passed but wrong # of tests run |
| any other number how many failed (including missing or extras) |
| |
| If you fail more than 254 tests, it will be reported as 254. |
| |
| B<NOTE> This behavior may go away in future versions. |
| |
| |
| =head1 CAVEATS and NOTES |
| |
| =over 4 |
| |
| =item Backwards compatibility |
| |
| Test::More works with Perls as old as 5.6.0. |
| |
| |
| =item utf8 / "Wide character in print" |
| |
| If you use utf8 or other non-ASCII characters with Test::More you |
| might get a "Wide character in print" warning. Using C<binmode |
| STDOUT, ":utf8"> will not fix it. Test::Builder (which powers |
| Test::More) duplicates STDOUT and STDERR. So any changes to them, |
| including changing their output disciplines, will not be seem by |
| Test::More. |
| |
| The work around is to change the filehandles used by Test::Builder |
| directly. |
| |
| my $builder = Test::More->builder; |
| binmode $builder->output, ":utf8"; |
| binmode $builder->failure_output, ":utf8"; |
| binmode $builder->todo_output, ":utf8"; |
| |
| |
| =item Overloaded objects |
| |
| String overloaded objects are compared B<as strings> (or in cmp_ok()'s |
| case, strings or numbers as appropriate to the comparison op). This |
| prevents Test::More from piercing an object's interface allowing |
| better blackbox testing. So if a function starts returning overloaded |
| objects instead of bare strings your tests won't notice the |
| difference. This is good. |
| |
| However, it does mean that functions like is_deeply() cannot be used to |
| test the internals of string overloaded objects. In this case I would |
| suggest L<Test::Deep> which contains more flexible testing functions for |
| complex data structures. |
| |
| |
| =item Threads |
| |
| Test::More will only be aware of threads if "use threads" has been done |
| I<before> Test::More is loaded. This is ok: |
| |
| use threads; |
| use Test::More; |
| |
| This may cause problems: |
| |
| use Test::More |
| use threads; |
| |
| 5.8.1 and above are supported. Anything below that has too many bugs. |
| |
| =back |
| |
| |
| =head1 HISTORY |
| |
| This is a case of convergent evolution with Joshua Pritikin's Test |
| module. I was largely unaware of its existence when I'd first |
| written my own ok() routines. This module exists because I can't |
| figure out how to easily wedge test names into Test's interface (along |
| with a few other problems). |
| |
| The goal here is to have a testing utility that's simple to learn, |
| quick to use and difficult to trip yourself up with while still |
| providing more flexibility than the existing Test.pm. As such, the |
| names of the most common routines are kept tiny, special cases and |
| magic side-effects are kept to a minimum. WYSIWYG. |
| |
| |
| =head1 SEE ALSO |
| |
| L<Test::Simple> if all this confuses you and you just want to write |
| some tests. You can upgrade to Test::More later (it's forward |
| compatible). |
| |
| L<Test::Harness> is the test runner and output interpreter for Perl. |
| It's the thing that powers C<make test> and where the C<prove> utility |
| comes from. |
| |
| L<Test::Legacy> tests written with Test.pm, the original testing |
| module, do not play well with other testing libraries. Test::Legacy |
| emulates the Test.pm interface and does play well with others. |
| |
| L<Test::Differences> for more ways to test complex data structures. |
| And it plays well with Test::More. |
| |
| L<Test::Class> is like xUnit but more perlish. |
| |
| L<Test::Deep> gives you more powerful complex data structure testing. |
| |
| L<Test::Inline> shows the idea of embedded testing. |
| |
| L<Bundle::Test> installs a whole bunch of useful test modules. |
| |
| |
| =head1 AUTHORS |
| |
| Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration |
| from Joshua Pritikin's Test module and lots of help from Barrie |
| Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and |
| the perl-qa gang. |
| |
| |
| =head1 BUGS |
| |
| See F<http://rt.cpan.org> to report and view bugs. |
| |
| |
| =head1 SOURCE |
| |
| The source code repository for Test::More can be found at |
| F<http://github.com/schwern/test-more/>. |
| |
| |
| =head1 COPYRIGHT |
| |
| Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>. |
| |
| This program is free software; you can redistribute it and/or |
| modify it under the same terms as Perl itself. |
| |
| See F<http://www.perl.com/perl/misc/Artistic.html> |
| |
| =cut |
| |
| 1; |