By Ian Langworth, chromatic
Price: $29.95 USD
£20.95 GBP
Cover | Table of Contents | Colophon
CPAN module that comes with Perl. To install a new version of the Test::Simple distribution, launch the CPAN shell with the cpan script:
% cpan
cpan shell -- CPAN exploration and modules installation (v1.7601)
ReadLine support enabled
cpan> install Test::Simple
Running install for module Test::Simple
Running make for M/MS/MSCHWERN/Test-Simple-0.54.tar.gz
<...>
Appending installation info to /usr/lib/perl5/5.8.6/powerpc-linux/perllocal.pod
/usr/bin/make install UNINST=1 -- OKTest::Simple had any dependencies (it doesn't), the shell would have detected them and tried to install them first.CPANCPAN module that comes with Perl. To install a new version of the Test::Simple distribution, launch the CPAN shell with the cpan script:
% cpan
cpan shell -- CPAN exploration and modules installation (v1.7601)
ReadLine support enabled
cpan> install Test::Simple
Running install for module Test::Simple
Running make for M/MS/MSCHWERN/Test-Simple-0.54.tar.gz
<...>
Appending installation info to /usr/lib/perl5/5.8.6/powerpc-linux/perllocal.pod
/usr/bin/make install UNINST=1 -- OKTest::Simple had any dependencies (it doesn't), the shell would have detected them and tried to install them first.CPAN module before, it will prompt you for all sorts of information about your machine and network configuration as well as your installation preferences. Usually the defaults are fine.http://www.activestate.com/Products/ActivePerl/), which includes the ppm utility to download, configure, build, and install modules. With ActivePerl installed, open a console window and type:
C:\>PPM
PPM> install Test-Simple
Test::Harness (see http://search.cpan.org/dist/Test-Harness) from the CPAN and extract it to its own directory. Change to this directory and build the module as usual (see "Installing Test Modules," earlier in this chapter). To run all of the tests at once, type make
test:
$ make test
PERL_DL_NONLAZY=1 /usr/bin/perl5.8.6 "-MExtUtils::Command::MM" "-e" \
"test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/00compile.........ok 1/5# Testing Test::Harness 2.46
t/00compile.........ok
t/assert............ok
t/base..............ok
t/callback..........ok
t/harness...........ok
t/inc_taint.........ok
t/nonumbers.........ok
t/ok................ok
t/pod...............ok
t/prove-globbing....ok
t/prove-switches....ok
t/strap-analyze.....ok
t/strap.............ok
t/test-harness......ok
56/208 skipped: various reasons
All tests successful, 56 subtests skipped.
Files=14, Tests=551, 6 wallclock secs ( 4.52 cusr + 0.97 csys = 5.49 CPU)make test is the third step of nearly every Perl module installation. This command runs all of the test files it can find through Test::Harness, which summarizes and reports the results. It also takes care of setting the paths appropriately for as-yet-uninstalled modules.make test comes from ExtUtils::MakeMaker, an old and venerable module. Module::Build is easier to use in some cases. If there's a Build.PL file, instead use the commands perl Build.PL, perl Build, and perl Build test. Everything will behave as described here.make test, as it runs all of the tests for a distribution in a specific order. If you want to run a few tests individually, use Test::Builder). You'll probably never have to write your own testing protocol, but understanding TAP will help you interpret your test results and write better tests.
#!perl
print <<END_HERE;
1..9
ok 1
not ok 2
# Failed test (t/sample_output.t at line 10)
# got: '2'
# expected: '4'
ok 3
ok 4 - this is test 4
not ok 5 - test 5 should look good too
not ok 6 # TODO fix test 6
# I haven't had time add the feature for test 6
ok 7 # skip these tests never pass in examples
ok 8 # skip these tests never pass in examples
ok 9 # skip these tests never pass in examples
END_HERE
$ prove sample_output.pl
sample_output....FAILED tests 2, 5
Failed 2/9 tests, 77.789 okay (less 3 skipped tests: 4 okay, 44.44%)
Failed Test Stat Wstat Total Fail Failed List of Failed
------------------------------------------------------------------------
sample_output.pl 9 2 22.22% 2 5
3 subtests skipped.
Failed 1/1 test scripts, 0.00% okay. 2/9 subtests failed, 77.79% okay.Test::Simple, the simplest testing module. You'll see how to write your own test for a simple "Hello, world!"-style program.
#!perl
use strict;
use warnings;
use Test::Simple tests => 1;
sub hello_world
{
return "Hello, world!";
}
ok( hello_world() eq "Hello, world!" );
$ prove hello.t
hello....ok
All tests successful.
Files=1, Tests=1, 0 wallclock secs ( 0.09 cusr + 0.00 csys = 0.09 CPU)Test::Simple module. It defines a simple subroutine. There's no special syntax a decent Perl programmer doesn't already know.Test::Simple. By convention, all test files need a plan to declare how many tests you expect to run. If you run the test file with perl and not prove, you'll notice that the plan output comes before the test output:
$ perl hello.t
1..1
ok 1ok() subroutine. It comes from Test::Simple and is the module's only export. ok() is very, very simple. It reports a passed or a failed test, depending on the truth of its first argument. In the example, if whatever hello_world() returns is equal to the string Hello, world!, ok() will report that the test has passed.'no_plan' on the use line lets Test::Simple know that you're playing it by ear. In this case, it'll keep its own count of tests and report that you ran as many as you ran.Test::More.AnalyzeSentence that performs some basic word counting. Save the following code in your library directory as AnalyzeSentence.pm:
package AnalyzeSentence;
use strict;
use warnings;
use base 'Exporter';
our $WORD_SEPARATOR = qr/\s+/;
our @EXPORT_OK = qw( $WORD_SEPARATOR count_words words );
sub words
{
my $sentence = shift;
return split( $WORD_SEPARATOR, $sentence );
}
sub count_words
{
my $sentence = shift;
return scalar words( $sentence );
}
1;words() and count_words() do the right thing, a good test should test that the module loads and imports the two subroutines correctly. Save the following test file as analyze_sentence.t:
#!perl
use strict;
use warnings;
use Test::More tests => 5;
my @subs = qw( words count_words );
use_ok( 'AnalyzeSentence', @subs );
can_ok( _ _PACKAGE_ _, 'words' );
can_ok( _ _PACKAGE_ _, 'count_words' );
my $sentence =
'Queen Esther, ruler of the Frog-Human Alliance, briskly devours a
monumental ice cream sundae in her honor.';
my @words = words( $sentence );
ok( @words = = 17, 'words() should return all words in sentence' );
$sentence = 'Rampaging ideas flutter greedily.';
my $count = count_words( $sentence );
ok( $count = = 4, 'count_words() should handle simple sentences' );ok() may be the basis of all testing, but it can be inconvenient to have to reduce every test in your system to a single conditional expression. Fortunately, Test::More provides several other testing functions that can make your work easier. You'll likely end up using these functions more often than ok().Test::More.Greeter, which takes the name and age of a person and allows her to greet other people. Save this code as greeter.t:
#!perl
use strict;
use warnings;
use Test::More tests => 4;
use_ok( 'Greeter' ) or exit;
my $greeter = Greeter->new( name => 'Emily', age => 21 );
isa_ok( $greeter, 'Greeter' );
is( $greeter->age(), 21,
'age() should return age for object' );
like( $greeter->greet(), qr/Hello, .+ is Emily!/,
'greet() should include object name' );
package Greeter;
sub new
{
my ($class, %args) = @_;
bless \%args, $class;
}
sub name
{
my $self = shift;
return $self->{name};
}
sub age
{
my $self = shift;
return $self->{age};
}
sub greet
{
my $self = shift;
return "Hello, my name is " . $self->name() . "!";
}
1;
$ prove greeter.t
greeter.t....ok
All tests successful.
Files=1, Tests=4, 0 wallclock secs ( 0.07 cusr + 0.03 csys = 0.10 CPU)Greeter module and creating a new Greeter object for Emily, age 21. The first test checks to see if the constructor returned an actual Greeter object. isa_ok() performs several checks to see if the variable is actually a defined reference, for example. It fails if it is an undefined value, a non-reference, or an object of any class other than the appropriate class or a derived class.ok() function described in Chapter 1.Test::More and other commonly used testing modules. You'll learn how to control which tests run and why, how to compare expected and received data effectively, and how to test exceptional conditions. These are crucial techniques that provide the building blocks for writing comprehensive test suites.Phrase class stores some text and provides a constructor, an accessor, and an as_dutch() method that returns the text translated to Dutch.
package Phrase;
use strict;
sub new
{
my ( $class, $text ) = @_;
bless \$text, $class;
}
sub text
{
my $self = shift;
return $$self;
}
sub as_dutch
{
my $self = shift;
require WWW::Babelfish;
return WWW::Babelfish->new->translate(
source => 'English',
destination => 'Dutch',
text => $self->text(),
);
}
1;WWW::Babelfish translation module installed. That's fine; you've decided that Phrase's as_dutch() feature is optional. How can you test that, though?
#!perl
use strict;
use Test::More tests => 3;
use Phrase;
my $phrase = Phrase->new('Good morning!');
isa_ok( $phrase, 'Phrase' );
is( $phrase->text(), 'Good morning!', "text() access works" );
SKIP:
{
eval 'use WWW::Babelfish';
skip( 'because WWW::Babelfish required for as_dutch()', 1 ) if $@;
is(
$phrase->as_dutch,
'Goede ochtend!',
"successfully translated to Dutch"
);
}Phrase class stores some text and provides a constructor, an accessor, and an as_dutch() method that returns the text translated to Dutch.
package Phrase;
use strict;
sub new
{
my ( $class, $text ) = @_;
bless \$text, $class;
}
sub text
{
my $self = shift;
return $$self;
}
sub as_dutch
{
my $self = shift;
require WWW::Babelfish;
return WWW::Babelfish->new->translate(
source => 'English',
destination => 'Dutch',
text => $self->text(),
);
}
1;WWW::Babelfish translation module installed. That's fine; you've decided that Phrase's as_dutch() feature is optional. How can you test that, though?
#!perl
use strict;
use Test::More tests => 3;
use Phrase;
my $phrase = Phrase->new('Good morning!');
isa_ok( $phrase, 'Phrase' );
is( $phrase->text(), 'Good morning!', "text() access works" );
SKIP:
{
eval 'use WWW::Babelfish';
skip( 'because WWW::Babelfish required for as_dutch()', 1 ) if $@;
is(
$phrase->as_dutch,
'Goede ochtend!',
"successfully translated to Dutch"
);
}WWW::Babelfish installed, you will see the following output:
$ prove -v phrase.t
phrase....1..3
ok 1 - The object isa Phrase
ok 2 - text() access works
ok 3 - successfully translated to Dutch
ok
All tests successful.
Files=1, Tests=3, 1 wallclock secs ( 0.16 cusr + 0.01 csys = 0.17 CPU)Test::More provides a bit of useful syntax for this situation.plan function on its own instead of specifying the tests in the use() statement. The following code checks to see if the current weekday is Tuesday. If it is not, the test will skip all of the tests. Save it as skip_all.t:
use Test::More;
if ( [ localtime ]->[6] != 2 )
{
plan( skip_all => 'only run these tests on Tuesday' );
}
else
{
plan( tests => 1 );
}
require Tuesday;
my $day = Tuesday->new();
ok( $day->coat(), 'we brought our coat' );
package Tuesday;
sub new
{
bless { }, shift;
}
# wear a coat only on Tuesday
sub coat
{
return [ localtime ]->[6] = = 2;
}
1;
$ prove -v skip_all.t
chapter_01/skipping_all_tests....1..1
ok 1 - we brought our coat
ok
All tests successful.
Files=1, Tests=1, 1 wallclock secs ( 0.13 cusr + 0.04 csys = 0.17 CPU)
$ prove -v skip_all.t
chapter_01/skipping_all_tests....1..0 # Skip only run these tests on Tuesday skipped
all skipped: only run these tests on Tuesday
All tests successful, 1 test skipped.
Files=1, Tests=0, 0 wallclock secs ( 0.14 cusr + 0.05 csys = 0.19 CPU)use keyword, skip_all.t uses Test::More's plan() function to determine the test plan when the script runs. If the current weekday is not Tuesday, the code calls plan() with two arguments: an instruction to run no tests and a reason why. If it is Tuesday, the code reports the regular test plan and execution continues as normal.File::Future, and save the following code to File/Future.pm, creating the File/ directory first if necessary:
package File::Future;
use strict;
sub new
{
my ($class, $filename) = @_;
bless { filename => $filename }, $class;
}
sub retrieve
{
# implement later...
}
1;File::Future constructor takes a file path and returns an object. Calling retrieve() on the object with a date retrieves that file at the given date. Unfortunately, there is no Perl extension to flux capacitors yet. For now, hold off on writing the implementation of retrieve().Acme::FluxFS finally appears. It's easy to test that. Save the following code as future.t:
use Test::More tests => 4;
use File::Future;
my $file = File::Future->new( 'perl_testing_dn.pod' );
isa_ok( $file, 'File::Future' );
TODO: {
local $TODO = 'continuum not yet harnessed';
ok( my $current = $file->retrieve( 'January 30, 2005' ) );
ok( my $future = $file->retrieve( 'January 30, 2070' ) );
cmp_ok( length($current), '<', length($future),
'ensuring that we have added text by 2070' );
}
$ prove -v future.t
future.t....1..4
ok 1 - The object isa File::Future
not ok 2 # TODO continuum not yet harnessed
# Failed (TODO) test (future.t.pl at line 14)
not ok 3 # TODO continuum not yet harnessed
# Failed (TODO) test (future.t.pl at line 15)
not ok 4 - ensuring that we have added text by 2070 # TODO
continuum not yet harnessed
# Failed (TODO) test (future.t at line 13)
# '0'
# <
# '0'
ok
All tests successful.
Files=1, Tests=4, 0 wallclock secs ( 0.02 cusr + 0.00 csys = 0.02 CPU)Test::More's is() function checks scalar equality, but what about more complicated structures, such as lists of lists of lists? Good tests often need to peer into these data structures to test whether, deep down inside, they are truly equal. The first solution that may come to mind is a recursive function or a series of nested loops. Hold that thought, though—Test::More and other test modules provide a better way with their comparison functions.
use Test::More tests => 1;
my $list1 =
[
[
[ 48, 12 ],
[ 32, 10 ],
],
[
[ 03, 28 ],
],
];
my $list2 =
[
[
[ 48, 12 ],
[ 32, 11 ],
],
[
[ 03, 28 ],
],
];
is_deeply( $list1, $list2, 'existential equivalence' );prove -v to see the diagnostics:
$ prove -v deeply.t
deeply....1..1
not ok 1 - existential equivalence
# Failed test (deeply.t at line 23)
# Structures begin differing at:
# $got->[0][1][1] = '10'
# $expected->[0][1][1] = '11'
# Looks like you failed 1 tests of 1.
dubious
Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 1
Failed 1/1 tests, 0.00% okay
Failed 1/1 test scripts, 0.00% okay. 1/1 subtests failed, 0.00% okay.
Failed Test Stat Wstat Total Fail Failed List of Failed
---------------------------------------------------------------------------
deeply.t 1 256 1 1 100.00% 1is_deeply() function exported by Test::More. Note the difference between the two lists. Because the first array contains a 10 where the second contains an 11, the test failed.$list1 and $list2. If there are multiple differences in the data structure, is_deeply() will display only the first. Additionally, if one of the data structures is missing an element, is_deeply() will show that as well.Test::Deep module neatens up code testing complicated data structures and provides sensible error messages.
use Test::More tests => 1;
use Test::Deep;
my $points =
[
{ x => 50, y => 75 },
{ x => 19, y => -29 },
];
my $is_integer = re('^-?\d+$');
cmp_deeply( $points,
array_each(
{
x => $is_integer,
y => $is_integer,
}
),
'both sets of points should be integers' );
$ prove cmp_deeply.t
cmp_deep....ok
All tests successful.
Files=1, Tests=1, 0 wallclock secs ( 0.06 cusr + 0.00 csys = 0.06 CPU)cmp_deeply(), like most other testing functions, accepts two or three arguments: the data structure to test, what you expect the structure to look like, and an optional test description. The expected data, however, is a special test structure with a format containing special Test::Deep functions.re(), a function exported by Test::Deep. re() declares that the data must match the given regular expression. If you use a regular expression reference instead, Test::Deep believes you expect the data to be a regular expression instead of matching the data against it.Test::Deep's array_each() function creates the main test structure for the test. To pass the test, $points must be an array reference. Every element of the array must validate against the test structure passed to array_each().Test::Warn module provides helpful test functions to trap and examine warnings.
use Test::More tests => 4;
use Test::Warn;
sub add_positives
{
my ( $l, $r ) = @_;
warn "first argument ($l) was negative" if $l < 0;
warn "second argument ($r) was negative" if $r < 0;
return $l + $r;
}
warning_is { is( add_positives( 8, -3 ), 5 ) }
"second argument (-3) was negative";
warnings_are { is( add_positives( -8, -3 ), -11 ) }
[
'first argument (-8) was negative',
'second argument (-3) was negative'
];
$ prove -v warnings.t
warnings....1..4
ok 1
ok 2
ok 3
ok 4
ok
All tests successful.
Files=1, Tests=4, 0 wallclock secs ( 0.04 cusr + 0.00 csys = 0.04 CPU)add_positives(). The function adds two numbers together and warns the user if either number is less than zero.warning_is() takes a block of code to run and the text of the warning expected. Like most other test functions, it takes an optional third argument as the test description. Passing two less-than-zero arguments to add_positives() causes the subroutine to produce two warnings. To test for multiple warnings, use Test::Warn's warnings_are(). Instead of a single string, warnings_are() takes a reference to an array of complete warning strings as its second argument.Test::Warn also exports warning_like()Test::Exception provides the functions to test that a block of code throws (or doesn't throw) the exceptions that you expect.add_positives() from "Testing Warnings," but your coworkers can't seem to use it correctly. They happily pass in negative numbers and ignore the warnings, and then blame you when their code fails to work properly. Your team lead has suggested that you strengthen the function to hate negative numbers—so much so that it throws an exception if it encounters one. How can you test that?
use Test::More tests => 3;
use Test::Exception;
use Error;
sub add_positives
{
my ($l, $r) = @_;
throw Error::Simple("first argument ($l) was negative") if $l < 0;
throw Error::Simple("second argument ($r) was negative") if $r < 0;
return $l + $r;
}
throws_ok { add_positives( -7, 6 ) } 'Error::Simple';
throws_ok { add_positives( 3, -9 ) } 'Error::Simple';
throws_ok { add_positives( -5, -1 ) } 'Error::Simple';
$ prove -v exception.t
exception....1..3
ok 1 - threw Error::Simple
ok 2 - threw Error::Simple
ok 3 - threw Error::Simple
ok
All tests successful.
Files=1, Tests=3, 0 wallclock secs ( 0.03 cusr + 0.00 csys = 0.03 CPU)throws_ok() ensures that add_positives() throws an exception of type Error::Simple. throws_ok() performs an isa() check on the exceptions it catches, so you can alternatively specify any superclass of the exception thrown. For example, because exceptions inherit from the Error class, you can replace all occurrences of Error::Simple in Test::Harness module. Download the latest distribution from the CPAN and extract it. Change into the newly created directory, run Makefile.PL, and build and test the module:http://search.cpan.org/dist/Test-Harnes/
.
$ perl Makefile.PL
Checking if your kit is complete...
Looks good
Writing Makefile for Test::Harness
$ make
cp lib/Test/Harness/TAP.pod blib/lib/Test/Harness/TAP.pod
cp lib/Test/Harness/Iterator.pm blib/lib/Test/Harness/Iterator.pm
cp lib/Test/Harness/Assert.pm blib/lib/Test/Harness/Assert.pm
cp lib/Test/Harness.pm blib/lib/Test/Harness.pm
cp lib/Test/Harness/Straps.pm blib/lib/Test/Harness/Straps.pm
cp bin/prove blib/script/prove
/usr/bin/perl5.8.6 "-MExtUtils::MY" -e "MY->fixin(shift)" blib/script/prove
<output snipped>
$ make test
PERL_DL_NONLAZY=1 /usr/bin/perl5.8.6 "-MExtUtils::Command::MM" "-e"
"test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
<output snipped>Test::Harness module. Download the latest distribution from the CPAN and extract it. Change into the newly created directory, run Makefile.PL, and build and test the module:http://search.cpan.org/dist/Test-Harnes/
.
$ perl Makefile.PL
Checking if your kit is complete...
Looks good
Writing Makefile for Test::Harness
$ make
cp lib/Test/Harness/TAP.pod blib/lib/Test/Harness/TAP.pod
cp lib/Test/Harness/Iterator.pm blib/lib/Test/Harness/Iterator.pm
cp lib/Test/Harness/Assert.pm blib/lib/Test/Harness/Assert.pm
cp lib/Test/Harness.pm blib/lib/Test/Harness.pm
cp lib/Test/Harness/Straps.pm blib/lib/Test/Harness/Straps.pm
cp bin/prove blib/script/prove
/usr/bin/perl5.8.6 "-MExtUtils::MY" -e "MY->fixin(shift)" blib/script/prove
<output snipped>
$ make test
PERL_DL_NONLAZY=1 /usr/bin/perl5.8.6 "-MExtUtils::Command::MM" "-e"
"test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
<output snipped>Devel::Cover module from the CPAN automates the analysis and reporting for you. Best of all, it works with the standard Perl test harness.Devel::Cover and its dependencies (see "Installing Test Modules" in Chapter 1). You need the ability to build XS modules, unless you install it via ppm or some other binary package.Test::Harness (see "Organizing Tests," earlier in this chapter), build the module, and then run the following commands:
$ cover -delete
Deleting database /home/chromatic/dev/install/Test-Harness-2.46/cover_db
$ HARNESS_PERL_SWITCHES=-MDevel::Cover make test
PERL_DL_NONLAZY=1 /usr/bin/perl5.8.6 "-MExtUtils::Command::MM" "-e"
"test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/00compile.........ok 1/5# Testing Test::Harness 2.46
t/00compile.........ok
t/assert............ok
t/base..............ok
t/callback..........ok
t/harness...........ok
t/inc_taint.........ok
t/nonumbers.........ok
t/ok................ok
t/pod...............ok
t/prove-globbing....ok
t/prove-switches....ok
t/strap-analyze.....ok
t/strap.............ok
t/test-harness......ok
56/208 skipped: various reasons
All tests successful, 56 subtests skipped.
Files=14, Tests=551, 255 wallclock secs
(209.59 cusr + 4.98 csys = 214.57 CPU)
$ cover
Reading database from /home/chromatic/dev/Test-Harness-2.46/cover_db
---------------------------------- ------ ------ ------ ------ ------ ------
File stmt branch cond sub time total
---------------------------------- ------ ------ ------ ------ ------ ------
blib/lib/Test/Harness.pm 71.6 51.6 61.1 80.8 0.0 65.9
blib/lib/Test/Harness/Assert.pm 100.0 100.0 n/a 100.0 0.0 100.0
blib/lib/Test/Harness/Iterator.pm 70.0 25.0 n/a 80.0 98.9 65.5
blib/lib/Test/Harness/Straps.pm 92.9 82.7 69.0 96.2 1.0 87.6
Total 80.8 66.0 65.4 88.3 100.0 76.0
---------------------------------- ------ ------ ------ ------ ------ ------
Writing HTML output to /home/chromatic/dev/Test-Harness-2.46/cover_db/coverage.html ...
done.Test::Builder makes it possible.is_between(), that tests whether a given value is between two other values. Save the code under a lib/ directory where you can reach it (see "Installing Test Modules," in Chapter 1) as Test/Between.pm:
package Test::Between;
use strict;
use warnings;
use base 'Exporter';
our@EXPORT = qw( is_between );
use Test::Builder;
my $Test = Test::Builder->new();
sub is_between ($$$;$)
{
my ($item, $lower, $upper, $desc) = @_;
return
(
$Test->ok( "$lower" le "$item" && "$item" le "$upper", $desc ) ||
$Test->diag( " $item is not between $lower and $upper" )
);
}
1;
#!perl
use strict;
use warnings;
use Test::More tests => 3;
use Test::Between;
is_between( 'b', 'a', 'c', 'simple alphabetical comparison' );
is_between( 2 , 1 , 3 , 'simple numeric comparison' );
is_between( "two", 1 , 3 , 'mixed comparison' );Test::Builder makes writing custom testing
libraries easy (see the previous lab, "Writing a Testing Library") by handling all of the distracting test bookkeeping and management. They're just code. Good libraries need good tests, though.Test::Builder makes writing tests for these custom libraries easier too, with a little help from Test::Builder::Tester.Test::Between (from "Writing a Testing Library"). Save the following test file as between.t:
#!perl
use strict;
use warnings;
use Test::Between;
use Test::Builder::Tester tests => 3;
my $desc;
$desc = 'simple alphabetical comparison';
test_pass( $desc );
is_between( 'b', 'a', 'c', $desc );
test_test( $desc );
$desc = 'simple numeric comparison';
test_pass( $desc );
is_between( 2, 1, 3, $desc );
test_test( $desc );
$desc = 'mixed comparison';
test_out( "not ok 1 - $desc" );
test_fail( +2 );
test_diag( ' two is not between 1 and 3' );
is_between( "two", 1, 3, $desc );
test_test( 'failed comparison with diagnostics' );
$ perl between.t
1..3
ok 1 - simple alphabetical comparison
ok 2 - simple numeric comparison
ok 3 - failed comparison with diagnosticsTest::Between except for one twist: instead of using Test::More to declare a test plan, it uses Test::Builder::Tester, which provides its own test plan. From there, it has three blocks of tests that correspond to the tests shown in "Writing a Testing Library"--an alphabetical comparison that should pass, a numeric comparison that should also pass, and a mixed comparison that should fail.Test::Builder::Tester works by collecting information about what a test should do, running the test, and comparing its actual output to the expected output. Then it reports the results. This requires you to know if the test should pass or fail and what kind of output it will produce.Test::Harness already knows how to interpret the results. However, Test::Harness only prints out what it discovers.Test::Harness::Straps is a thin wrapper around a TAP parser. It collects the results in a data structure but does not analyze or print them. Writing a program to report those results in an alternate format is easy. If you want to do something when tests fail, or if you want to do something more complicated than simply reporting test results, why not write your own testing harness?
#!perl
use strict;
use warnings;
use Test::Harness::Straps;
my $strap = Test::Harness::Straps->new();
for my $file (@ARGV)
{
next unless -f $file;
my %results = $strap->analyze_file( $file );
printf <<END_REPORT, $file, @results{qw( max seen ok skip todo bonus )};
Results for %s
Expected tests: %d
Tests run: %d
Tested passed: %d
Tests skipped: %d
TODO tests: %d
TODO tests passed: %d
END_REPORT
}Test::Harness suite, for example):
$ new_harness t/strap*t
Results for t/strap-analyze.t
Expected tests: 108
Tests run: 108
Tested passed: 108
Tests skipped: 0
TODO tests: 0
TODO tests passed: 0
Results for t/strap.t
Expected tests: 176
Tests run: 176
Tested passed: 176
Tests skipped: 0
TODO tests: 0
TODO tests passed: 0Test::Harness::Straps makes writing custom test harnesses easy, but it's more flexible than you might think. Its input can come from anywhere. Have you ever wanted to run tests on a remote machine and summarize their output locally? That's no problem.
use Net::SSH::Perl;
use Test::Harness::Straps;
my $strap = Test::Harness::Straps->new();
my $ssh = Net::SSH::Perl->new( 'testbox' );
$ssh->login(qw( username password ));
my ($stdout, $stderr, $exit) = $ssh->cmd( 'runtests' );
my %results = $strap->analyze_fh( 'testbox tests', $stdout );
# parse %results as normalruntests command to the remote machine, collects the results, and passes the output of the command to the TAP parser object. From there, do whatever you like with the results.analyze() method:
use LWP::Simple;
use Test::Harness::Straps;
my $strap = Test::Harness::Straps->new();
my $output = get( 'http://testbox/tests/smoketest.t' );
my @lines = split( /\n/, $output );
my %results = $strap->analyze( 'testbox smoketest', \@lines );
# parse %results as normal