1N/Apackage Test::More;
1N/A
1N/Ause 5.004;
1N/A
1N/Ause strict;
1N/Ause Test::Builder;
1N/A
1N/A
1N/A# Can't use Carp because it might cause use_ok() to accidentally succeed
1N/A# even though the module being used forgot to use Carp. Yes, this
1N/A# actually happened.
1N/Asub _carp {
1N/A my($file, $line) = (caller(1))[1,2];
1N/A warn @_, " at $file line $line\n";
1N/A}
1N/A
1N/A
1N/A
1N/Arequire Exporter;
1N/Ause vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
1N/A$VERSION = '0.47';
1N/A@ISA = qw(Exporter);
1N/A@EXPORT = qw(ok use_ok require_ok
1N/A is isnt like unlike is_deeply
1N/A cmp_ok
1N/A skip todo todo_skip
1N/A pass fail
1N/A eq_array eq_hash eq_set
1N/A $TODO
1N/A plan
1N/A can_ok isa_ok
1N/A diag
1N/A );
1N/A
1N/Amy $Test = Test::Builder->new;
1N/A
1N/A
1N/A# 5.004's Exporter doesn't have export_to_level.
1N/Asub _export_to_level
1N/A{
1N/A my $pkg = shift;
1N/A my $level = shift;
1N/A (undef) = shift; # redundant arg
1N/A my $callpkg = caller($level);
1N/A $pkg->export($callpkg, @_);
1N/A}
1N/A
1N/A
1N/A=head1 NAME
1N/A
1N/ATest::More - yet another framework for writing test scripts
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A use Test::More tests => $Num_Tests;
1N/A # or
1N/A use Test::More qw(no_plan);
1N/A # or
1N/A use Test::More skip_all => $reason;
1N/A
1N/A BEGIN { use_ok( 'Some::Module' ); }
1N/A require_ok( 'Some::Module' );
1N/A
1N/A # Various ways to say "ok"
1N/A ok($this eq $that, $test_name);
1N/A
1N/A is ($this, $that, $test_name);
1N/A isnt($this, $that, $test_name);
1N/A
1N/A # Rather than print STDERR "# here's what went wrong\n"
1N/A diag("here's what went wrong");
1N/A
1N/A like ($this, qr/that/, $test_name);
1N/A unlike($this, qr/that/, $test_name);
1N/A
1N/A cmp_ok($this, '==', $that, $test_name);
1N/A
1N/A is_deeply($complex_structure1, $complex_structure2, $test_name);
1N/A
1N/A SKIP: {
1N/A skip $why, $how_many unless $have_some_feature;
1N/A
1N/A ok( foo(), $test_name );
1N/A is( foo(42), 23, $test_name );
1N/A };
1N/A
1N/A TODO: {
1N/A local $TODO = $why;
1N/A
1N/A ok( foo(), $test_name );
1N/A is( foo(42), 23, $test_name );
1N/A };
1N/A
1N/A can_ok($module, @methods);
1N/A isa_ok($object, $class);
1N/A
1N/A pass($test_name);
1N/A fail($test_name);
1N/A
1N/A # Utility comparison functions.
1N/A eq_array(\@this, \@that);
1N/A eq_hash(\%this, \%that);
1N/A eq_set(\@this, \@that);
1N/A
1N/A # UNIMPLEMENTED!!!
1N/A my @status = Test::More::status;
1N/A
1N/A # UNIMPLEMENTED!!!
1N/A BAIL_OUT($why);
1N/A
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AB<STOP!> If you're just getting started writing tests, have a look at
1N/ATest::Simple first. This is a drop in replacement for Test::Simple
1N/Awhich you can switch to once you get the hang of basic testing.
1N/A
1N/AThe purpose of this module is to provide a wide range of testing
1N/Autilities. Various ways to say "ok" with better diagnostics,
1N/Afacilities to skip tests, test future features and compare complicated
1N/Adata structures. While you can do almost anything with a simple
1N/AC<ok()> function, it doesn't provide good diagnostic output.
1N/A
1N/A
1N/A=head2 I love it when a plan comes together
1N/A
1N/ABefore anything else, you need a testing plan. This basically declares
1N/Ahow many tests your script is going to run to protect against premature
1N/Afailure.
1N/A
1N/AThe preferred way to do this is to declare a plan when you C<use Test::More>.
1N/A
1N/A use Test::More tests => $Num_Tests;
1N/A
1N/AThere are rare cases when you will not know beforehand how many tests
1N/Ayour script is going to run. In this case, you can declare that you
1N/Ahave no plan. (Try to avoid using this as it weakens your test.)
1N/A
1N/A use Test::More qw(no_plan);
1N/A
1N/AIn some cases, you'll want to completely skip an entire testing script.
1N/A
1N/A use Test::More skip_all => $skip_reason;
1N/A
1N/AYour script will declare a skip with the reason why you skipped and
1N/Aexit immediately with a zero (success). See L<Test::Harness> for
1N/Adetails.
1N/A
1N/AIf you want to control what functions Test::More will export, you
1N/Ahave to use the 'import' option. For example, to import everything
1N/Abut 'fail', you'd do:
1N/A
1N/A use Test::More tests => 23, import => ['!fail'];
1N/A
1N/AAlternatively, you can use the plan() function. Useful for when you
1N/Ahave to calculate the number of tests.
1N/A
1N/A use Test::More;
1N/A plan tests => keys %Stuff * 3;
1N/A
1N/Aor for deciding between running the tests at all:
1N/A
1N/A use Test::More;
1N/A if( $^O eq 'MacOS' ) {
1N/A plan skip_all => 'Test irrelevant on MacOS';
1N/A }
1N/A else {
1N/A plan tests => 42;
1N/A }
1N/A
1N/A=cut
1N/A
1N/Asub plan {
1N/A my(@plan) = @_;
1N/A
1N/A my $caller = caller;
1N/A
1N/A $Test->exported_to($caller);
1N/A
1N/A my @imports = ();
1N/A foreach my $idx (0..$#plan) {
1N/A if( $plan[$idx] eq 'import' ) {
1N/A my($tag, $imports) = splice @plan, $idx, 2;
1N/A @imports = @$imports;
1N/A last;
1N/A }
1N/A }
1N/A
1N/A $Test->plan(@plan);
1N/A
1N/A __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
1N/A}
1N/A
1N/Asub import {
1N/A my($class) = shift;
1N/A goto &plan;
1N/A}
1N/A
1N/A
1N/A=head2 Test names
1N/A
1N/ABy convention, each test is assigned a number in order. This is
1N/Alargely done automatically for you. However, it's often very useful to
1N/Aassign a name to each test. Which would you rather see:
1N/A
1N/A ok 4
1N/A not ok 5
1N/A ok 6
1N/A
1N/Aor
1N/A
1N/A ok 4 - basic multi-variable
1N/A not ok 5 - simple exponential
1N/A ok 6 - force == mass * acceleration
1N/A
1N/AThe later gives you some idea of what failed. It also makes it easier
1N/Ato find the test in your script, simply search for "simple
1N/Aexponential".
1N/A
1N/AAll test functions take a name argument. It's optional, but highly
1N/Asuggested that you use it.
1N/A
1N/A
1N/A=head2 I'm ok, you're not ok.
1N/A
1N/AThe basic purpose of this module is to print out either "ok #" or "not
1N/Aok #" depending on if a given test succeeded or failed. Everything
1N/Aelse is just gravy.
1N/A
1N/AAll of the following print "ok" or "not ok" depending on if the test
1N/Asucceeded or failed. They all also return true or false,
1N/Arespectively.
1N/A
1N/A=over 4
1N/A
1N/A=item B<ok>
1N/A
1N/A ok($this eq $that, $test_name);
1N/A
1N/AThis simply evaluates any expression (C<$this eq $that> is just a
1N/Asimple example) and uses that to determine if the test succeeded or
1N/Afailed. A true expression passes, a false one fails. Very simple.
1N/A
1N/AFor example:
1N/A
1N/A ok( $exp{9} == 81, 'simple exponential' );
1N/A ok( Film->can('db_Main'), 'set_db()' );
1N/A ok( $p->tests == 4, 'saw tests' );
1N/A ok( !grep !defined $_, @items, 'items populated' );
1N/A
1N/A(Mnemonic: "This is ok.")
1N/A
1N/A$test_name is a very short description of the test that will be printed
1N/Aout. It makes it very easy to find a test in your script when it fails
1N/Aand gives others an idea of your intentions. $test_name is optional,
1N/Abut we B<very> strongly encourage its use.
1N/A
1N/AShould an ok() fail, it will produce some diagnostics:
1N/A
1N/A not ok 18 - sufficient mucus
1N/A # Failed test 18 (foo.t at line 42)
1N/A
1N/AThis is actually Test::Simple's ok() routine.
1N/A
1N/A=cut
1N/A
1N/Asub ok ($;$) {
1N/A my($test, $name) = @_;
1N/A $Test->ok($test, $name);
1N/A}
1N/A
1N/A=item B<is>
1N/A
1N/A=item B<isnt>
1N/A
1N/A is ( $this, $that, $test_name );
1N/A isnt( $this, $that, $test_name );
1N/A
1N/ASimilar to ok(), is() and isnt() compare their two arguments
1N/Awith C<eq> and C<ne> respectively and use the result of that to
1N/Adetermine if the test succeeded or failed. So these:
1N/A
1N/A # Is the ultimate answer 42?
1N/A is( ultimate_answer(), 42, "Meaning of Life" );
1N/A
1N/A # $foo isn't empty
1N/A isnt( $foo, '', "Got some foo" );
1N/A
1N/Aare similar to these:
1N/A
1N/A ok( ultimate_answer() eq 42, "Meaning of Life" );
1N/A ok( $foo ne '', "Got some foo" );
1N/A
1N/A(Mnemonic: "This is that." "This isn't that.")
1N/A
1N/ASo why use these? They produce better diagnostics on failure. ok()
1N/Acannot know what you are testing for (beyond the name), but is() and
1N/Aisnt() know what the test was and why it failed. For example this
1N/Atest:
1N/A
1N/A my $foo = 'waffle'; my $bar = 'yarblokos';
1N/A is( $foo, $bar, 'Is foo the same as bar?' );
1N/A
1N/AWill produce something like this:
1N/A
1N/A not ok 17 - Is foo the same as bar?
1N/A # Failed test (foo.t at line 139)
1N/A # got: 'waffle'
1N/A # expected: 'yarblokos'
1N/A
1N/ASo you can figure out what went wrong without rerunning the test.
1N/A
1N/AYou are encouraged to use is() and isnt() over ok() where possible,
1N/Ahowever do not be tempted to use them to find out if something is
1N/Atrue or false!
1N/A
1N/A # XXX BAD! $pope->isa('Catholic') eq 1
1N/A is( $pope->isa('Catholic'), 1, 'Is the Pope Catholic?' );
1N/A
1N/AThis does not check if C<$pope->isa('Catholic')> is true, it checks if
1N/Ait returns 1. Very different. Similar caveats exist for false and 0.
1N/AIn these cases, use ok().
1N/A
1N/A ok( $pope->isa('Catholic') ), 'Is the Pope Catholic?' );
1N/A
1N/AFor those grammatical pedants out there, there's an C<isn't()>
1N/Afunction which is an alias of isnt().
1N/A
1N/A=cut
1N/A
1N/Asub is ($$;$) {
1N/A $Test->is_eq(@_);
1N/A}
1N/A
1N/Asub isnt ($$;$) {
1N/A $Test->isnt_eq(@_);
1N/A}
1N/A
1N/A*isn't = \&isnt;
1N/A
1N/A
1N/A=item B<like>
1N/A
1N/A like( $this, qr/that/, $test_name );
1N/A
1N/ASimilar to ok(), like() matches $this against the regex C<qr/that/>.
1N/A
1N/ASo this:
1N/A
1N/A like($this, qr/that/, 'this is like that');
1N/A
1N/Ais similar to:
1N/A
1N/A ok( $this =~ /that/, 'this is like that');
1N/A
1N/A(Mnemonic "This is like that".)
1N/A
1N/AThe second argument is a regular expression. It may be given as a
1N/Aregex reference (i.e. C<qr//>) or (for better compatibility with older
1N/Aperls) as a string that looks like a regex (alternative delimiters are
1N/Acurrently not supported):
1N/A
1N/A like( $this, '/that/', 'this is like that' );
1N/A
1N/ARegex options may be placed on the end (C<'/that/i'>).
1N/A
1N/AIts advantages over ok() are similar to that of is() and isnt(). Better
1N/Adiagnostics on failure.
1N/A
1N/A=cut
1N/A
1N/Asub like ($$;$) {
1N/A $Test->like(@_);
1N/A}
1N/A
1N/A
1N/A=item B<unlike>
1N/A
1N/A unlike( $this, qr/that/, $test_name );
1N/A
1N/AWorks exactly as like(), only it checks if $this B<does not> match the
1N/Agiven pattern.
1N/A
1N/A=cut
1N/A
1N/Asub unlike {
1N/A $Test->unlike(@_);
1N/A}
1N/A
1N/A
1N/A=item B<cmp_ok>
1N/A
1N/A cmp_ok( $this, $op, $that, $test_name );
1N/A
1N/AHalfway between ok() and is() lies cmp_ok(). This allows you to
1N/Acompare two arguments using any binary perl operator.
1N/A
1N/A # ok( $this eq $that );
1N/A cmp_ok( $this, 'eq', $that, 'this eq that' );
1N/A
1N/A # ok( $this == $that );
1N/A cmp_ok( $this, '==', $that, 'this == that' );
1N/A
1N/A # ok( $this && $that );
1N/A cmp_ok( $this, '&&', $that, 'this || that' );
1N/A ...etc...
1N/A
1N/AIts advantage over ok() is when the test fails you'll know what $this
1N/Aand $that were:
1N/A
1N/A not ok 1
1N/A # Failed test (foo.t at line 12)
1N/A # '23'
1N/A # &&
1N/A # undef
1N/A
1N/AIt's also useful in those cases where you are comparing numbers and
1N/Ais()'s use of C<eq> will interfere:
1N/A
1N/A cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
1N/A
1N/A=cut
1N/A
1N/Asub cmp_ok($$$;$) {
1N/A $Test->cmp_ok(@_);
1N/A}
1N/A
1N/A
1N/A=item B<can_ok>
1N/A
1N/A can_ok($module, @methods);
1N/A can_ok($object, @methods);
1N/A
1N/AChecks to make sure the $module or $object can do these @methods
1N/A(works with functions, too).
1N/A
1N/A can_ok('Foo', qw(this that whatever));
1N/A
1N/Ais almost exactly like saying:
1N/A
1N/A ok( Foo->can('this') &&
1N/A Foo->can('that') &&
1N/A Foo->can('whatever')
1N/A );
1N/A
1N/Aonly without all the typing and with a better interface. Handy for
1N/Aquickly testing an interface.
1N/A
1N/ANo matter how many @methods you check, a single can_ok() call counts
1N/Aas one test. If you desire otherwise, use:
1N/A
1N/A foreach my $meth (@methods) {
1N/A can_ok('Foo', $meth);
1N/A }
1N/A
1N/A=cut
1N/A
1N/Asub can_ok ($@) {
1N/A my($proto, @methods) = @_;
1N/A my $class = ref $proto || $proto;
1N/A
1N/A unless( @methods ) {
1N/A my $ok = $Test->ok( 0, "$class->can(...)" );
1N/A $Test->diag(' can_ok() called with no methods');
1N/A return $ok;
1N/A }
1N/A
1N/A my @nok = ();
1N/A foreach my $method (@methods) {
1N/A local($!, $@); # don't interfere with caller's $@
1N/A # eval sometimes resets $!
1N/A eval { $proto->can($method) } || push @nok, $method;
1N/A }
1N/A
1N/A my $name;
1N/A $name = @methods == 1 ? "$class->can('$methods[0]')"
1N/A : "$class->can(...)";
1N/A
1N/A my $ok = $Test->ok( !@nok, $name );
1N/A
1N/A $Test->diag(map " $class->can('$_') failed\n", @nok);
1N/A
1N/A return $ok;
1N/A}
1N/A
1N/A=item B<isa_ok>
1N/A
1N/A isa_ok($object, $class, $object_name);
1N/A isa_ok($ref, $type, $ref_name);
1N/A
1N/AChecks to see if the given $object->isa($class). Also checks to make
1N/Asure the object was defined in the first place. Handy for this sort
1N/Aof thing:
1N/A
1N/A my $obj = Some::Module->new;
1N/A isa_ok( $obj, 'Some::Module' );
1N/A
1N/Awhere you'd otherwise have to write
1N/A
1N/A my $obj = Some::Module->new;
1N/A ok( defined $obj && $obj->isa('Some::Module') );
1N/A
1N/Ato safeguard against your test script blowing up.
1N/A
1N/AIt works on references, too:
1N/A
1N/A isa_ok( $array_ref, 'ARRAY' );
1N/A
1N/AThe diagnostics of this test normally just refer to 'the object'. If
1N/Ayou'd like them to be more specific, you can supply an $object_name
1N/A(for example 'Test customer').
1N/A
1N/A=cut
1N/A
1N/Asub isa_ok ($$;$) {
1N/A my($object, $class, $obj_name) = @_;
1N/A
1N/A my $diag;
1N/A $obj_name = 'The object' unless defined $obj_name;
1N/A my $name = "$obj_name isa $class";
1N/A if( !defined $object ) {
1N/A $diag = "$obj_name isn't defined";
1N/A }
1N/A elsif( !ref $object ) {
1N/A $diag = "$obj_name isn't a reference";
1N/A }
1N/A else {
1N/A # We can't use UNIVERSAL::isa because we want to honor isa() overrides
1N/A local($@, $!); # eval sometimes resets $!
1N/A my $rslt = eval { $object->isa($class) };
1N/A if( $@ ) {
1N/A if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
1N/A if( !UNIVERSAL::isa($object, $class) ) {
1N/A my $ref = ref $object;
1N/A $diag = "$obj_name isn't a '$class' it's a '$ref'";
1N/A }
1N/A } else {
1N/A die <<WHOA;
1N/AWHOA! I tried to call ->isa on your object and got some weird error.
1N/AThis should never happen. Please contact the author immediately.
1N/AHere's the error.
1N/A$@
1N/AWHOA
1N/A }
1N/A }
1N/A elsif( !$rslt ) {
1N/A my $ref = ref $object;
1N/A $diag = "$obj_name isn't a '$class' it's a '$ref'";
1N/A }
1N/A }
1N/A
1N/A
1N/A
1N/A my $ok;
1N/A if( $diag ) {
1N/A $ok = $Test->ok( 0, $name );
1N/A $Test->diag(" $diag\n");
1N/A }
1N/A else {
1N/A $ok = $Test->ok( 1, $name );
1N/A }
1N/A
1N/A return $ok;
1N/A}
1N/A
1N/A
1N/A=item B<pass>
1N/A
1N/A=item B<fail>
1N/A
1N/A pass($test_name);
1N/A fail($test_name);
1N/A
1N/ASometimes you just want to say that the tests have passed. Usually
1N/Athe case is you've got some complicated condition that is difficult to
1N/Awedge into an ok(). In this case, you can simply use pass() (to
1N/Adeclare the test ok) or fail (for not ok). They are synonyms for
1N/Aok(1) and ok(0).
1N/A
1N/AUse these very, very, very sparingly.
1N/A
1N/A=cut
1N/A
1N/Asub pass (;$) {
1N/A $Test->ok(1, @_);
1N/A}
1N/A
1N/Asub fail (;$) {
1N/A $Test->ok(0, @_);
1N/A}
1N/A
1N/A=back
1N/A
1N/A=head2 Diagnostics
1N/A
1N/AIf you pick the right test function, you'll usually get a good idea of
1N/Awhat went wrong when it failed. But sometimes it doesn't work out
1N/Athat way. So here we have ways for you to write your own diagnostic
1N/Amessages which are safer than just C<print STDERR>.
1N/A
1N/A=over 4
1N/A
1N/A=item B<diag>
1N/A
1N/A diag(@diagnostic_message);
1N/A
1N/APrints a diagnostic message which is guaranteed not to interfere with
1N/Atest output. Handy for this sort of thing:
1N/A
1N/A ok( grep(/foo/, @users), "There's a foo user" ) or
1N/A diag("Since there's no foo, check that /etc/bar is set up right");
1N/A
1N/Awhich would produce:
1N/A
1N/A not ok 42 - There's a foo user
1N/A # Failed test (foo.t at line 52)
1N/A # Since there's no foo, check that /etc/bar is set up right.
1N/A
1N/AYou might remember C<ok() or diag()> with the mnemonic C<open() or
1N/Adie()>.
1N/A
1N/AB<NOTE> The exact formatting of the diagnostic output is still
1N/Achanging, but it is guaranteed that whatever you throw at it it won't
1N/Ainterfere with the test.
1N/A
1N/A=cut
1N/A
1N/Asub diag {
1N/A $Test->diag(@_);
1N/A}
1N/A
1N/A
1N/A=back
1N/A
1N/A=head2 Module tests
1N/A
1N/AYou usually want to test if the module you're testing loads ok, rather
1N/Athan just vomiting if its load fails. For such purposes we have
1N/AC<use_ok> and C<require_ok>.
1N/A
1N/A=over 4
1N/A
1N/A=item B<use_ok>
1N/A
1N/A BEGIN { use_ok($module); }
1N/A BEGIN { use_ok($module, @imports); }
1N/A
1N/AThese simply use the given $module and test to make sure the load
1N/Ahappened ok. It's recommended that you run use_ok() inside a BEGIN
1N/Ablock so its functions are exported at compile-time and prototypes are
1N/Aproperly honored.
1N/A
1N/AIf @imports are given, they are passed through to the use. So this:
1N/A
1N/A BEGIN { use_ok('Some::Module', qw(foo bar)) }
1N/A
1N/Ais like doing this:
1N/A
1N/A use Some::Module qw(foo bar);
1N/A
1N/Adon't try to do this:
1N/A
1N/A BEGIN {
1N/A use_ok('Some::Module');
1N/A
1N/A ...some code that depends on the use...
1N/A ...happening at compile time...
1N/A }
1N/A
1N/Ainstead, you want:
1N/A
1N/A BEGIN { use_ok('Some::Module') }
1N/A BEGIN { ...some code that depends on the use... }
1N/A
1N/A
1N/A=cut
1N/A
1N/Asub use_ok ($;@) {
1N/A my($module, @imports) = @_;
1N/A @imports = () unless @imports;
1N/A
1N/A my $pack = caller;
1N/A
1N/A local($@,$!); # eval sometimes interferes with $!
1N/A eval <<USE;
1N/Apackage $pack;
1N/Arequire $module;
1N/A'$module'->import(\@imports);
1N/AUSE
1N/A
1N/A my $ok = $Test->ok( !$@, "use $module;" );
1N/A
1N/A unless( $ok ) {
1N/A chomp $@;
1N/A $Test->diag(<<DIAGNOSTIC);
1N/A Tried to use '$module'.
1N/A Error: $@
1N/ADIAGNOSTIC
1N/A
1N/A }
1N/A
1N/A return $ok;
1N/A}
1N/A
1N/A=item B<require_ok>
1N/A
1N/A require_ok($module);
1N/A
1N/ALike use_ok(), except it requires the $module.
1N/A
1N/A=cut
1N/A
1N/Asub require_ok ($) {
1N/A my($module) = shift;
1N/A
1N/A my $pack = caller;
1N/A
1N/A local($!, $@); # eval sometimes interferes with $!
1N/A eval <<REQUIRE;
1N/Apackage $pack;
1N/Arequire $module;
1N/AREQUIRE
1N/A
1N/A my $ok = $Test->ok( !$@, "require $module;" );
1N/A
1N/A unless( $ok ) {
1N/A chomp $@;
1N/A $Test->diag(<<DIAGNOSTIC);
1N/A Tried to require '$module'.
1N/A Error: $@
1N/ADIAGNOSTIC
1N/A
1N/A }
1N/A
1N/A return $ok;
1N/A}
1N/A
1N/A=back
1N/A
1N/A=head2 Conditional tests
1N/A
1N/ASometimes running a test under certain conditions will cause the
1N/Atest script to die. A certain function or method isn't implemented
1N/A(such as fork() on MacOS), some resource isn't available (like a
1N/Anet connection) or a module isn't available. In these cases it's
1N/Anecessary to skip tests, or declare that they are supposed to fail
1N/Abut will work in the future (a todo test).
1N/A
1N/AFor more details on the mechanics of skip and todo tests see
1N/AL<Test::Harness>.
1N/A
1N/AThe way Test::More handles this is with a named block. Basically, a
1N/Ablock of tests which can be skipped over or made todo. It's best if I
1N/Ajust show you...
1N/A
1N/A=over 4
1N/A
1N/A=item B<SKIP: BLOCK>
1N/A
1N/A SKIP: {
1N/A skip $why, $how_many if $condition;
1N/A
1N/A ...normal testing code goes here...
1N/A }
1N/A
1N/AThis declares a block of tests that might be skipped, $how_many tests
1N/Athere are, $why and under what $condition to skip them. An example is
1N/Athe easiest way to illustrate:
1N/A
1N/A SKIP: {
1N/A eval { require HTML::Lint };
1N/A
1N/A skip "HTML::Lint not installed", 2 if $@;
1N/A
1N/A my $lint = new HTML::Lint;
1N/A isa_ok( $lint, "HTML::Lint" );
1N/A
1N/A $lint->parse( $html );
1N/A is( $lint->errors, 0, "No errors found in HTML" );
1N/A }
1N/A
1N/AIf the user does not have HTML::Lint installed, the whole block of
1N/Acode I<won't be run at all>. Test::More will output special ok's
1N/Awhich Test::Harness interprets as skipped, but passing, tests.
1N/AIt's important that $how_many accurately reflects the number of tests
1N/Ain the SKIP block so the # of tests run will match up with your plan.
1N/A
1N/AIt's perfectly safe to nest SKIP blocks. Each SKIP block must have
1N/Athe label C<SKIP>, or Test::More can't work its magic.
1N/A
1N/AYou don't skip tests which are failing because there's a bug in your
1N/Aprogram, or for which you don't yet have code written. For that you
1N/Ause TODO. Read on.
1N/A
1N/A=cut
1N/A
1N/A#'#
1N/Asub skip {
1N/A my($why, $how_many) = @_;
1N/A
1N/A unless( defined $how_many ) {
1N/A # $how_many can only be avoided when no_plan is in use.
1N/A _carp "skip() needs to know \$how_many tests are in the block"
1N/A unless $Test::Builder::No_Plan;
1N/A $how_many = 1;
1N/A }
1N/A
1N/A for( 1..$how_many ) {
1N/A $Test->skip($why);
1N/A }
1N/A
1N/A local $^W = 0;
1N/A last SKIP;
1N/A}
1N/A
1N/A
1N/A=item B<TODO: BLOCK>
1N/A
1N/A TODO: {
1N/A local $TODO = $why if $condition;
1N/A
1N/A ...normal testing code goes here...
1N/A }
1N/A
1N/ADeclares a block of tests you expect to fail and $why. Perhaps it's
1N/Abecause you haven't fixed a bug or haven't finished a new feature:
1N/A
1N/A TODO: {
1N/A local $TODO = "URI::Geller not finished";
1N/A
1N/A my $card = "Eight of clubs";
1N/A is( URI::Geller->your_card, $card, 'Is THIS your card?' );
1N/A
1N/A my $spoon;
1N/A URI::Geller->bend_spoon;
1N/A is( $spoon, 'bent', "Spoon bending, that's original" );
1N/A }
1N/A
1N/AWith a todo block, the tests inside are expected to fail. Test::More
1N/Awill run the tests normally, but print out special flags indicating
1N/Athey are "todo". Test::Harness will interpret failures as being ok.
1N/AShould anything succeed, it will report it as an unexpected success.
1N/AYou then know the thing you had todo is done and can remove the
1N/ATODO flag.
1N/A
1N/AThe nice part about todo tests, as opposed to simply commenting out a
1N/Ablock of tests, is it's like having a programmatic todo list. You know
1N/Ahow much work is left to be done, you're aware of what bugs there are,
1N/Aand you'll know immediately when they're fixed.
1N/A
1N/AOnce a todo test starts succeeding, simply move it outside the block.
1N/AWhen the block is empty, delete it.
1N/A
1N/A
1N/A=item B<todo_skip>
1N/A
1N/A TODO: {
1N/A todo_skip $why, $how_many if $condition;
1N/A
1N/A ...normal testing code...
1N/A }
1N/A
1N/AWith todo tests, it's best to have the tests actually run. That way
1N/Ayou'll know when they start passing. Sometimes this isn't possible.
1N/AOften a failing test will cause the whole program to die or hang, even
1N/Ainside an C<eval BLOCK> with and using C<alarm>. In these extreme
1N/Acases you have no choice but to skip over the broken tests entirely.
1N/A
1N/AThe syntax and behavior is similar to a C<SKIP: BLOCK> except the
1N/Atests will be marked as failing but todo. Test::Harness will
1N/Ainterpret them as passing.
1N/A
1N/A=cut
1N/A
1N/Asub todo_skip {
1N/A my($why, $how_many) = @_;
1N/A
1N/A unless( defined $how_many ) {
1N/A # $how_many can only be avoided when no_plan is in use.
1N/A _carp "todo_skip() needs to know \$how_many tests are in the block"
1N/A unless $Test::Builder::No_Plan;
1N/A $how_many = 1;
1N/A }
1N/A
1N/A for( 1..$how_many ) {
1N/A $Test->todo_skip($why);
1N/A }
1N/A
1N/A local $^W = 0;
1N/A last TODO;
1N/A}
1N/A
1N/A=item When do I use SKIP vs. TODO?
1N/A
1N/AB<If it's something the user might not be able to do>, use SKIP.
1N/AThis includes optional modules that aren't installed, running under
1N/Aan OS that doesn't have some feature (like fork() or symlinks), or maybe
1N/Ayou need an Internet connection and one isn't available.
1N/A
1N/AB<If it's something the programmer hasn't done yet>, use TODO. This
1N/Ais for any code you haven't written yet, or bugs you have yet to fix,
1N/Abut want to put tests in your testing script (always a good idea).
1N/A
1N/A
1N/A=back
1N/A
1N/A=head2 Comparison functions
1N/A
1N/ANot everything is a simple eq check or regex. There are times you
1N/Aneed to see if two arrays are equivalent, for instance. For these
1N/Ainstances, Test::More provides a handful of useful functions.
1N/A
1N/AB<NOTE> These are NOT well-tested on circular references. Nor am I
1N/Aquite sure what will happen with filehandles.
1N/A
1N/A=over 4
1N/A
1N/A=item B<is_deeply>
1N/A
1N/A is_deeply( $this, $that, $test_name );
1N/A
1N/ASimilar to is(), except that if $this and $that are hash or array
1N/Areferences, it does a deep comparison walking each data structure to
1N/Asee if they are equivalent. If the two structures are different, it
1N/Awill display the place where they start differing.
1N/A
1N/ABarrie Slaymaker's Test::Differences module provides more in-depth
1N/Afunctionality along these lines, and it plays well with Test::More.
1N/A
1N/AB<NOTE> Display of scalar refs is not quite 100%
1N/A
1N/A=cut
1N/A
1N/Ause vars qw(@Data_Stack);
1N/Amy $DNE = bless [], 'Does::Not::Exist';
1N/Asub is_deeply {
1N/A my($this, $that, $name) = @_;
1N/A
1N/A my $ok;
1N/A if( !ref $this || !ref $that ) {
1N/A $ok = $Test->is_eq($this, $that, $name);
1N/A }
1N/A else {
1N/A local @Data_Stack = ();
1N/A if( _deep_check($this, $that) ) {
1N/A $ok = $Test->ok(1, $name);
1N/A }
1N/A else {
1N/A $ok = $Test->ok(0, $name);
1N/A $ok = $Test->diag(_format_stack(@Data_Stack));
1N/A }
1N/A }
1N/A
1N/A return $ok;
1N/A}
1N/A
1N/Asub _format_stack {
1N/A my(@Stack) = @_;
1N/A
1N/A my $var = '$FOO';
1N/A my $did_arrow = 0;
1N/A foreach my $entry (@Stack) {
1N/A my $type = $entry->{type} || '';
1N/A my $idx = $entry->{'idx'};
1N/A if( $type eq 'HASH' ) {
1N/A $var .= "->" unless $did_arrow++;
1N/A $var .= "{$idx}";
1N/A }
1N/A elsif( $type eq 'ARRAY' ) {
1N/A $var .= "->" unless $did_arrow++;
1N/A $var .= "[$idx]";
1N/A }
1N/A elsif( $type eq 'REF' ) {
1N/A $var = "\${$var}";
1N/A }
1N/A }
1N/A
1N/A my @vals = @{$Stack[-1]{vals}}[0,1];
1N/A my @vars = ();
1N/A ($vars[0] = $var) =~ s/\$FOO/ \$got/;
1N/A ($vars[1] = $var) =~ s/\$FOO/\$expected/;
1N/A
1N/A my $out = "Structures begin differing at:\n";
1N/A foreach my $idx (0..$#vals) {
1N/A my $val = $vals[$idx];
1N/A $vals[$idx] = !defined $val ? 'undef' :
1N/A $val eq $DNE ? "Does not exist"
1N/A : "'$val'";
1N/A }
1N/A
1N/A $out .= "$vars[0] = $vals[0]\n";
1N/A $out .= "$vars[1] = $vals[1]\n";
1N/A
1N/A $out =~ s/^/ /msg;
1N/A return $out;
1N/A}
1N/A
1N/A
1N/A=item B<eq_array>
1N/A
1N/A eq_array(\@this, \@that);
1N/A
1N/AChecks if two arrays are equivalent. This is a deep check, so
1N/Amulti-level structures are handled correctly.
1N/A
1N/A=cut
1N/A
1N/A#'#
1N/Asub eq_array {
1N/A my($a1, $a2) = @_;
1N/A return 1 if $a1 eq $a2;
1N/A
1N/A my $ok = 1;
1N/A my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
1N/A for (0..$max) {
1N/A my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
1N/A my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
1N/A
1N/A push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
1N/A $ok = _deep_check($e1,$e2);
1N/A pop @Data_Stack if $ok;
1N/A
1N/A last unless $ok;
1N/A }
1N/A return $ok;
1N/A}
1N/A
1N/Asub _deep_check {
1N/A my($e1, $e2) = @_;
1N/A my $ok = 0;
1N/A
1N/A my $eq;
1N/A {
1N/A # Quiet uninitialized value warnings when comparing undefs.
1N/A local $^W = 0;
1N/A
1N/A if( $e1 eq $e2 ) {
1N/A $ok = 1;
1N/A }
1N/A else {
1N/A if( UNIVERSAL::isa($e1, 'ARRAY') and
1N/A UNIVERSAL::isa($e2, 'ARRAY') )
1N/A {
1N/A $ok = eq_array($e1, $e2);
1N/A }
1N/A elsif( UNIVERSAL::isa($e1, 'HASH') and
1N/A UNIVERSAL::isa($e2, 'HASH') )
1N/A {
1N/A $ok = eq_hash($e1, $e2);
1N/A }
1N/A elsif( UNIVERSAL::isa($e1, 'REF') and
1N/A UNIVERSAL::isa($e2, 'REF') )
1N/A {
1N/A push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
1N/A $ok = _deep_check($$e1, $$e2);
1N/A pop @Data_Stack if $ok;
1N/A }
1N/A elsif( UNIVERSAL::isa($e1, 'SCALAR') and
1N/A UNIVERSAL::isa($e2, 'SCALAR') )
1N/A {
1N/A push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
1N/A $ok = _deep_check($$e1, $$e2);
1N/A }
1N/A else {
1N/A push @Data_Stack, { vals => [$e1, $e2] };
1N/A $ok = 0;
1N/A }
1N/A }
1N/A }
1N/A
1N/A return $ok;
1N/A}
1N/A
1N/A
1N/A=item B<eq_hash>
1N/A
1N/A eq_hash(\%this, \%that);
1N/A
1N/ADetermines if the two hashes contain the same keys and values. This
1N/Ais a deep check.
1N/A
1N/A=cut
1N/A
1N/Asub eq_hash {
1N/A my($a1, $a2) = @_;
1N/A return 1 if $a1 eq $a2;
1N/A
1N/A my $ok = 1;
1N/A my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
1N/A foreach my $k (keys %$bigger) {
1N/A my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
1N/A my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
1N/A
1N/A push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
1N/A $ok = _deep_check($e1, $e2);
1N/A pop @Data_Stack if $ok;
1N/A
1N/A last unless $ok;
1N/A }
1N/A
1N/A return $ok;
1N/A}
1N/A
1N/A=item B<eq_set>
1N/A
1N/A eq_set(\@this, \@that);
1N/A
1N/ASimilar to eq_array(), except the order of the elements is B<not>
1N/Aimportant. This is a deep check, but the irrelevancy of order only
1N/Aapplies to the top level.
1N/A
1N/AB<NOTE> By historical accident, this is not a true set comparision.
1N/AWhile the order of elements does not matter, duplicate elements do.
1N/A
1N/A=cut
1N/A
1N/A# We must make sure that references are treated neutrally. It really
1N/A# doesn't matter how we sort them, as long as both arrays are sorted
1N/A# with the same algorithm.
1N/Asub _bogus_sort { local $^W = 0; ref $a ? 0 : $a cmp $b }
1N/A
1N/Asub eq_set {
1N/A my($a1, $a2) = @_;
1N/A return 0 unless @$a1 == @$a2;
1N/A
1N/A # There's faster ways to do this, but this is easiest.
1N/A return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
1N/A}
1N/A
1N/A=back
1N/A
1N/A
1N/A=head2 Extending and Embedding Test::More
1N/A
1N/ASometimes the Test::More interface isn't quite enough. Fortunately,
1N/ATest::More is built on top of Test::Builder which provides a single,
1N/Aunified backend for any test library to use. This means two test
1N/Alibraries which both use Test::Builder B<can be used together in the
1N/Asame program>.
1N/A
1N/AIf you simply want to do a little tweaking of how the tests behave,
1N/Ayou can access the underlying Test::Builder object like so:
1N/A
1N/A=over 4
1N/A
1N/A=item B<builder>
1N/A
1N/A my $test_builder = Test::More->builder;
1N/A
1N/AReturns the Test::Builder object underlying Test::More for you to play
1N/Awith.
1N/A
1N/A=cut
1N/A
1N/Asub builder {
1N/A return Test::Builder->new;
1N/A}
1N/A
1N/A=back
1N/A
1N/A
1N/A=head1 NOTES
1N/A
1N/ATest::More is B<explicitly> tested all the way back to perl 5.004.
1N/A
1N/ATest::More is thread-safe for perl 5.8.0 and up.
1N/A
1N/A=head1 BUGS and CAVEATS
1N/A
1N/A=over 4
1N/A
1N/A=item Making your own ok()
1N/A
1N/AIf you are trying to extend Test::More, don't. Use Test::Builder
1N/Ainstead.
1N/A
1N/A=item The eq_* family has some caveats.
1N/A
1N/A=item Test::Harness upgrades
1N/A
1N/Ano_plan and todo depend on new Test::Harness features and fixes. If
1N/Ayou're going to distribute tests that use no_plan or todo your
1N/Aend-users will have to upgrade Test::Harness to the latest one on
1N/ACPAN. If you avoid no_plan and TODO tests, the stock Test::Harness
1N/Awill work fine.
1N/A
1N/AIf you simply depend on Test::More, it's own dependencies will cause a
1N/ATest::Harness upgrade.
1N/A
1N/A=back
1N/A
1N/A
1N/A=head1 HISTORY
1N/A
1N/AThis is a case of convergent evolution with Joshua Pritikin's Test
1N/Amodule. I was largely unaware of its existence when I'd first
1N/Awritten my own ok() routines. This module exists because I can't
1N/Afigure out how to easily wedge test names into Test's interface (along
1N/Awith a few other problems).
1N/A
1N/AThe goal here is to have a testing utility that's simple to learn,
1N/Aquick to use and difficult to trip yourself up with while still
1N/Aproviding more flexibility than the existing Test.pm. As such, the
1N/Anames of the most common routines are kept tiny, special cases and
1N/Amagic side-effects are kept to a minimum. WYSIWYG.
1N/A
1N/A
1N/A=head1 SEE ALSO
1N/A
1N/AL<Test::Simple> if all this confuses you and you just want to write
1N/Asome tests. You can upgrade to Test::More later (it's forward
1N/Acompatible).
1N/A
1N/AL<Test::Differences> for more ways to test complex data structures.
1N/AAnd it plays well with Test::More.
1N/A
1N/AL<Test> is the old testing module. Its main benefit is that it has
1N/Abeen distributed with Perl since 5.004_05.
1N/A
1N/AL<Test::Harness> for details on how your test results are interpreted
1N/Aby Perl.
1N/A
1N/AL<Test::Unit> describes a very featureful unit testing interface.
1N/A
1N/AL<Test::Inline> shows the idea of embedded testing.
1N/A
1N/AL<SelfTest> is another approach to embedded testing.
1N/A
1N/A
1N/A=head1 AUTHORS
1N/A
1N/AMichael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
1N/Afrom Joshua Pritikin's Test module and lots of help from Barrie
1N/ASlaymaker, Tony Bowden, chromatic and the perl-qa gang.
1N/A
1N/A
1N/A=head1 COPYRIGHT
1N/A
1N/ACopyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1N/A
1N/AThis program is free software; you can redistribute it and/or
1N/Amodify it under the same terms as Perl itself.
1N/A
1N/ASee F<http://www.perl.com/perl/misc/Artistic.html>
1N/A
1N/A=cut
1N/A
1N/A1;