Группа :: Разработка/Perl
Пакет: perl-Exporter-Tidy
навигация по пакетам
Главная Изменения Спек Патчи Исходники Загрузить Gear Bugs and FR Repocop
Exporter-Tidy-0.07/ 0000755 0000000 0000000 00000000000 11600156501 0014150 5 ustar 00root root 0000000 0000000 Exporter-Tidy-0.07/Changes 0000644 0000000 0000000 00000000464 11600156501 0015447 0 ustar 00root root 0000000 0000000 Revision history for Perl extension Exporter::Tidy.
0.07 Fri Sep 14 13:02 2007
- Now any-OSI licensed.
0.06 Sat Apr 19 14:32 2003
- Added unit tests for _prefix
0.05 Released immediately after 0.04
- Fixed some mistakes
0.04 Sat Mar 29 22:53 2003
- First CPAN release
Exporter-Tidy-0.07/MANIFEST 0000644 0000000 0000000 00000000252 11600156501 0015300 0 ustar 00root root 0000000 0000000 Changes
Makefile.PL
MANIFEST
README
Tidy.pm
t/1.t
t/lib/Test/More.pm
t/lib/Test/Builder.pm
META.yml Module meta-data (added by MakeMaker)
Exporter-Tidy-0.07/META.yml 0000644 0000000 0000000 00000000454 11600156501 0015424 0 ustar 00root root 0000000 0000000 # http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Exporter-Tidy
version: 0.07
version_from: Tidy.pm
installdirs: site
requires:
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.30_01
Exporter-Tidy-0.07/Makefile.PL 0000644 0000000 0000000 00000000746 11600156501 0016131 0 ustar 00root root 0000000 0000000 use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'Exporter::Tidy',
'VERSION_FROM' => 'Tidy.pm', # finds $VERSION
'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'Tidy.pm', # retrieve abstract from module
AUTHOR => 'Juerd <juerd@utp.juerd.net>') : ()),
);
Exporter-Tidy-0.07/README 0000644 0000000 0000000 00000011531 11600156501 0015031 0 ustar 00root root 0000000 0000000 Exporter::Tidy
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
Or use CPANPLUS to automate the process.
Module documentation:
NAME
Exporter::Tidy - Another way of exporting symbols
SYNOPSIS
package MyModule::HTTP;
use Exporter::Tidy
default => [ qw(get) ],
other => [ qw(post head) ];
use MyModule::HTTP qw(:all);
use MyModule::HTTP qw(:default post);
use MyModule::HTTP qw(post);
use MyModule::HTTP _prefix => 'http_', qw(get post);
use MyModule::HTTP qw(get post), _prefix => 'http_', qw(head);
use MyModule::HTTP
_prefix => 'foo', qw(get post),
_prefix => 'bar', qw(get head);
package MyModule::Foo;
use Exporter::Tidy
default => [ qw($foo $bar quux) ],
_map => {
'$foo' => \$my_foo,
'$bar' => \$my_bar,
quux => sub { print "Hello, world!\n" }
};
package MyModule::Constants;
use Exporter::Tidy
default => [ qw(:all) ],
_map => {
FOO => sub () { 1 },
BAR => sub () { 2 },
OK => sub () { 1 },
FAILURE => sub () { 0 }
};
DESCRIPTION
This module serves as an easy, clean alternative to Exporter. Unlike
Exporter, it is not subclassed, but it simply exports a custom import()
into your namespace.
With Exporter::Tidy, you don't need to use any package global in your
module. Even the subs you export can be lexically scoped.
use Exporter::Tidy LIST
The list supplied to "use Exporter::Tidy" should be a key-value list.
Each key serves as a tag, used to group exportable symbols. The values
in this key-value list should be array references. There are a few
special tags:
all If you don't provide an "all" tag yourself, Tidy::Exporter
will generate one for you. It will contain all exportable
symbols.
default The "default" tag will be used if the user supplies no list to
the "use" statement.
_map With _map you should not use an array reference, but a hash
reference. Here, you can rewrite symbols to other names or
even define one on the spot by using a reference. You can "foo
=> 'bar'" to export "bar" if "foo" is requested.
Exportable symbols
Every symbol specified in a tag's array, or used as a key in _map's hash
is exportable.
Symbol types
You can export subs, scalars, arrays, hashes and typeglobs. Do not use
an ampersand ("&") for subs. All other types must have the proper sigil.
Importing from a module that uses Exporter::Tidy
You can use either a symbol name (without the sigil if it is a sub, or
with the appropriate sigil if it is not), or a tag name prefixed with a
colon. It is possible to import a symbol twice, but a symbol is never
exported twice under the same name, so you can use tags that overlap. If
you supply any list to the "use" statement, ":default" is no longer used
if not specified explicitly.
To avoid name clashes, it is possible to have symbols prefixed. Supply
"_prefix" followed by the prefix that you want. Multiple can be used.
use Some::Module qw(foo bar), _prefix => 'some_', qw(quux);
imports Some::Module::foo as foo, Some::Module::bar as bar, and
Some::Module::quux as some_quux. See the SYNOPSIS for more examples.
COMPARISON
Exporter::Tidy "versus" Exporter
These numbers are valid for my Linux system with Perl 5.8.0. Your
mileage may vary.
Speed
Exporting two symbols using no import list (@EXPORT and :default) is
approximately 10% faster with Exporter. But if you use any tag
explicitly, Exporter::Tidy is more than twice as fast (!) as Exporter.
Memory usage
perl -le'require X; print((split " ", `cat /proc/$$/stat`)[22])'
No module 3022848
Exporter::Tidy 3067904
Exporter 3084288
Exporter::Heavy 3174400
Exporter loads Exporter::Heavy automatically when needed. It is needed
to support exporter tags, amongst other things. Exporter::Tidy has all
functionality built into one module.
Both Exporter(::Heavy) and Exporter::Tidy delay loading Carp until it is
needed.
Usage
Exporter is subclassed and gets its information from package global
variables like @EXPORT, @EXPORT_OK and %EXPORT_TAGS.
Exporter::Tidy exports an "import" method and gets its information from
the "use" statement.
LICENSE
There is no license. This software was released into the public domain.
Do with it what you want, but on your own risk. The author disclaims any
responsibility.
AUTHOR
Juerd Waalboer <juerd@cpan.org> <http://juerd.nl/>
Exporter-Tidy-0.07/Tidy.pm 0000644 0000000 0000000 00000014432 11600156501 0015423 0 ustar 00root root 0000000 0000000 package Exporter::Tidy;
# use strict;
# no strict 'refs';
# our
$VERSION = '0.07';
sub import {
my (undef, %tags) = @_;
my $caller = caller;
my $map = delete($tags{_map});
my %available;
@available{ grep !ref, keys %$map } = () if $map;
@available{ grep !/^:/, map @$_, values %tags } = ();
$tags{all} ||= [ keys %available ];
*{"$caller\::import"} = sub {
my ($me, @symbols) = @_;
my $caller = caller;
@symbols = @{ $tags{default} } if @symbols == 0 and exists $tags{default};
my %exported;
my $prefix = '';
while (my $symbol = shift @symbols) {
$symbol eq '_prefix' and ($prefix = shift @symbols, next);
my $real = $map && exists $map->{$symbol} ? $map->{$symbol} : $symbol;
next if exists $exported{"$prefix$real"};
undef $exported{"$prefix$symbol"};
$i++;
$real =~ /^:(.*)/ and (
(exists $tags{$1} or
(require Carp, Carp::croak("Unknown tag: $1"))),
push(@symbols, @{ $tags{$1} }),
next
);
ref $real and (
$symbol =~ s/^[\@\$%*]//,
*{"$caller\::$prefix$symbol"} = $real,
next
);
exists $available{$symbol} or
(require Carp, Carp::croak("Unknown symbol: $real"));
my ($sigil, $name) = $real =~ /^([\@\$%*]?)(.*)/;
$symbol =~ s/^[\@\$%*]//;
*{"$caller\::$prefix$symbol"} =
$sigil eq '' ? \&{"$me\::$name"}
: $sigil eq '$' ? \${"$me\::$name"}
: $sigil eq '@' ? \@{"$me\::$name"}
: $sigil eq '%' ? \%{"$me\::$name"}
: $sigil eq '*' ? \*{"$me\::$name"}
: (require Carp, Carp::croak("Strange symbol: $real"));
}
};
}
1;
__END__
=head1 NAME
Exporter::Tidy - Another way of exporting symbols
=head1 SYNOPSIS
package MyModule::HTTP;
use Exporter::Tidy
default => [ qw(get) ],
other => [ qw(post head) ];
use MyModule::HTTP qw(:all);
use MyModule::HTTP qw(:default post);
use MyModule::HTTP qw(post);
use MyModule::HTTP _prefix => 'http_', qw(get post);
use MyModule::HTTP qw(get post), _prefix => 'http_', qw(head);
use MyModule::HTTP
_prefix => 'foo', qw(get post),
_prefix => 'bar', qw(get head);
package MyModule::Foo;
use Exporter::Tidy
default => [ qw($foo $bar quux) ],
_map => {
'$foo' => \$my_foo,
'$bar' => \$my_bar,
quux => sub { print "Hello, world!\n" }
};
package MyModule::Constants;
use Exporter::Tidy
default => [ qw(:all) ],
_map => {
FOO => sub () { 1 },
BAR => sub () { 2 },
OK => sub () { 1 },
FAILURE => sub () { 0 }
};
=head1 DESCRIPTION
This module serves as an easy, clean alternative to Exporter. Unlike Exporter,
it is not subclassed, but it simply exports a custom import() into your
namespace.
With Exporter::Tidy, you don't need to use any package global in your
module. Even the subs you export can be lexically scoped.
=head2 use Exporter::Tidy LIST
The list supplied to C<use Exporter::Tidy> should be a key-value list. Each
key serves as a tag, used to group exportable symbols. The values in this
key-value list should be array references.
There are a few special tags:
=over 10
=item all
If you don't provide an C<all> tag yourself, Tidy::Exporter will generate one
for you. It will contain all exportable symbols.
=item default
The C<default> tag will be used if the user supplies no list to the C<use>
statement.
=item _map
With _map you should not use an array reference, but a hash reference. Here,
you can rewrite symbols to other names or even define one on the spot by using
a reference. You can C<< foo => 'bar' >> to export C<bar> if C<foo> is
requested.
=back
=head2 Exportable symbols
Every symbol specified in a tag's array, or used as a key in _map's
hash is exportable.
=head2 Symbol types
You can export subs, scalars, arrays, hashes and typeglobs. Do not use an
ampersand (C<&>) for subs. All other types must have the proper sigil.
=head2 Importing from a module that uses Exporter::Tidy
You can use either a symbol name (without the sigil if it is a sub, or with the
appropriate sigil if it is not), or a tag name prefixed with a colon. It is
possible to import a symbol twice, but a symbol is never exported twice under
the same name, so you can use tags that overlap. If you supply any list to
the C<use> statement, C<:default> is no longer used if not specified explicitly.
To avoid name clashes, it is possible to have symbols prefixed. Supply
C<_prefix> followed by the prefix that you want. Multiple can be used.
use Some::Module qw(foo bar), _prefix => 'some_', qw(quux);
imports Some::Module::foo as foo, Some::Module::bar as bar, and
Some::Module::quux as some_quux. See the SYNOPSIS for more examples.
=head1 COMPARISON
Exporter::Tidy "versus" Exporter
These numbers are valid for my Linux system with Perl 5.8.0. Your mileage may
vary.
=head2 Speed
Exporting two symbols using no import list (@EXPORT and :default) is approximately
10% faster with Exporter. But if you use any tag explicitly, Exporter::Tidy is
more than twice as fast (!) as Exporter.
=head2 Memory usage
perl -le'require X; print((split " ", `cat /proc/$$/stat`)[22])'
No module 3022848
Exporter::Tidy 3067904
Exporter 3084288
Exporter::Heavy 3174400
Exporter loads Exporter::Heavy automatically when needed. It is needed to
support exporter tags, amongst other things. Exporter::Tidy has all
functionality built into one module.
Both Exporter(::Heavy) and Exporter::Tidy delay loading Carp until it is
needed.
=head2 Usage
Exporter is subclassed and gets its information from package global
variables like @EXPORT, @EXPORT_OK and %EXPORT_TAGS.
Exporter::Tidy exports an C<import> method and gets its information from
the C<use> statement.
=head1 LICENSE
Pick your favourite OSI approved license :)
http://www.opensource.org/licenses/alphabetical
=head1 ACKNOWLEDGEMENTS
Thanks to Aristotle Pagaltzis for suggesting the name Exporter::Tidy.
=head1 AUTHOR
Juerd Waalboer <juerd@cpan.org> <http://juerd.nl/>
=cut
Exporter-Tidy-0.07/t/ 0000755 0000000 0000000 00000000000 11600156501 0014413 5 ustar 00root root 0000000 0000000 Exporter-Tidy-0.07/t/1.t 0000644 0000000 0000000 00000006531 11600156501 0014745 0 ustar 00root root 0000000 0000000 use lib 't/lib';
use Test::More tests => 36;
BEGIN { require_ok('Exporter::Tidy') };
can_ok 'Exporter::Tidy', 'import';
ok(!defined(&import), 'We are clean');
Exporter::Tidy->import();
ok(defined(&import), 'We got an &import');
BEGIN {
package ET_Test1;
$INC{'ET_Test1.pm'} = 'dummy';
use Exporter::Tidy default => [ qw(foo1 $foo1 %foo1 @foo1 *bar1) ];
*foo1 = sub { 42 };
*foo1 = \ 'forty-two';
*foo1 = [ 1 .. 42 ];
*foo1 = { 42 => 'forty-two' };
*bar1 = sub { 'foo' };
*bar1 = \ 'foo';
*bar1 = [ 'foo' ];
*bar1 = { foo => 1 };
}
use ET_Test1;
ok(foo1() == 42, ':default CODE');
ok($foo1 eq 'forty-two', ':default SCALAR');
ok(@foo1 == 42, ':default ARRAY');
ok($foo1{42} eq 'forty-two', ':default HASH');
ok(bar1() eq 'foo', ':default GLOB/CODE');
ok($bar1 eq 'foo', ':default GLOB/SCALAR');
ok($bar1[0] eq 'foo', ':default GLOB/ARRAY');
ok($bar1{foo}, ':default GLOB/HASH');
BEGIN {
package ET_Test2;
$INC{'ET_Test2.pm'} = 'dummy';
use Exporter::Tidy tag => [ qw(foo2 $foo2 %foo2 @foo2 *bar2) ];
*foo2 = sub { 42 };
*foo2 = \ 'forty-two';
*foo2 = [ 1 .. 42 ];
*foo2 = { 42 => 'forty-two' };
*bar2 = sub { 'foo' };
*bar2 = \ 'foo';
*bar2 = [ 'foo' ];
*bar2 = { foo => 1 };
}
use ET_Test2 qw(:tag);
ok(foo2() == 42, ':tag CODE');
ok($foo2 eq 'forty-two', ':tag SCALAR');
ok(@foo2 == 42, ':tag ARRAY');
ok($foo2{42} eq 'forty-two', ':tag HASH');
ok(bar2() eq 'foo', ':tag GLOB/CODE');
ok($bar2 eq 'foo', ':tag GLOB/SCALAR');
ok($bar2[0] eq 'foo', ':tag GLOB/ARRAY');
ok($bar2{foo}, ':tag GLOB/HASH');
BEGIN {
package ET_Test3;
$INC{'ET_Test3.pm'} = 'dummy';
use Exporter::Tidy
_map => {
'foo3' => sub { 42 },
'$foo3' => \ 'forty-two',
'@foo3' => [ 1 .. 42 ],
'%foo3' => { 42 => 'forty-two' },
'*bar3' => \*bar3
};
*bar3 = sub { 'foo' };
*bar3 = \ 'foo';
*bar3 = [ 'foo' ];
*bar3 = { foo => 1 };
}
use ET_Test3 qw(foo3 $foo3 @foo3 %foo3 *bar3);
ok(foo3() == 42, '_map CODE');
ok($foo3 eq 'forty-two', '_map SCALAR');
ok(@foo3 == 42, '_map ARRAY');
ok($foo3{42} eq 'forty-two', '_map HASH');
ok(bar3() eq 'foo', '_map GLOB/CODE');
ok($bar3 eq 'foo', '_map GLOB/SCALAR');
ok($bar3[0] eq 'foo', '_map GLOB/ARRAY');
ok($bar3{foo}, '_map GLOB/HASH');
BEGIN {
package ET_Test4;
$INC{'ET_Test4.pm'} = 'dummy';
use Exporter::Tidy moo => [ qw(foo $foo %foo @foo *bar) ];
*foo = sub { 42 };
*foo = \ 'forty-two';
*foo = [ 1 .. 42 ];
*foo = { 42 => 'forty-two' };
*bar = sub { 'foo' };
*bar = \ 'foo';
*bar = [ 'foo' ];
*bar = { foo => 1 };
}
use ET_Test4
_prefix => 'foo_', qw(foo $foo %foo @foo),
_prefix => 'bar_', qw(*bar);
ok(foo_foo() == 42, '_prefix CODE');
ok($foo_foo eq 'forty-two', '_prefix SCALAR');
ok(@foo_foo == 42, '_prefix ARRAY');
ok($foo_foo{42} eq 'forty-two', '_prefix HASH');
ok(bar_bar() eq 'foo', '_prefix GLOB/CODE');
ok($bar_bar eq 'foo', '_prefix GLOB/SCALAR');
ok($bar_bar[0] eq 'foo', '_prefix GLOB/ARRAY');
ok($bar_bar{foo}, '_prefix GLOB/HASH');
# TODO
# Test failures
Exporter-Tidy-0.07/t/lib/ 0000755 0000000 0000000 00000000000 11600156501 0015161 5 ustar 00root root 0000000 0000000 Exporter-Tidy-0.07/t/lib/Test/ 0000755 0000000 0000000 00000000000 11600156501 0016100 5 ustar 00root root 0000000 0000000 Exporter-Tidy-0.07/t/lib/Test/Builder.pm 0000644 0000000 0000000 00000065177 11600156501 0020044 0 ustar 00root root 0000000 0000000 package Test::Builder;
use 5.004;
# $^C was only introduced in 5.005-ish. We do this to prevent
# use of uninitialized value warnings in older perls.
$^C ||= 0;
use strict;
use vars qw($VERSION $CLASS);
$VERSION = '0.15';
$CLASS = __PACKAGE__;
my $IsVMS = $^O eq 'VMS';
use vars qw($Level);
my @Test_Results = ();
my @Test_Details = ();
my($Test_Died) = 0;
my($Have_Plan) = 0;
my $Curr_Test = 0;
# Make Test::Builder thread-safe for ithreads.
BEGIN {
use Config;
if( $] >= 5.008 && $Config{useithreads} ) {
require threads;
require threads::shared;
threads::shared->import;
share(\$Curr_Test);
share(\@Test_Details);
share(\@Test_Results);
}
else {
*lock = sub { 0 };
}
}
=head1 NAME
Test::Builder - Backend for building test libraries
=head1 SYNOPSIS
package My::Test::Module;
use Test::Builder;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(ok);
my $Test = Test::Builder->new;
$Test->output('my_logfile');
sub import {
my($self) = shift;
my $pack = caller;
$Test->exported_to($pack);
$Test->plan(@_);
$self->export_to_level(1, $self, 'ok');
}
sub ok {
my($test, $name) = @_;
$Test->ok($test, $name);
}
=head1 DESCRIPTION
Test::Simple and Test::More have proven to be popular testing modules,
but they're not always flexible enough. Test::Builder provides the a
building block upon which to write your own test libraries I<which can
work together>.
=head2 Construction
=over 4
=item B<new>
my $Test = Test::Builder->new;
Returns a Test::Builder object representing the current state of the
test.
Since you only run one test per program, there is B<one and only one>
Test::Builder object. No matter how many times you call new(), you're
getting the same object. (This is called a singleton).
=cut
my $Test;
sub new {
my($class) = shift;
$Test ||= bless ['Move along, nothing to see here'], $class;
return $Test;
}
=back
=head2 Setting up tests
These methods are for setting up tests and declaring how many there
are. You usually only want to call one of these methods.
=over 4
=item B<exported_to>
my $pack = $Test->exported_to;
$Test->exported_to($pack);
Tells Test::Builder what package you exported your functions to.
This is important for getting TODO tests right.
=cut
my $Exported_To;
sub exported_to {
my($self, $pack) = @_;
if( defined $pack ) {
$Exported_To = $pack;
}
return $Exported_To;
}
=item B<plan>
$Test->plan('no_plan');
$Test->plan( skip_all => $reason );
$Test->plan( tests => $num_tests );
A convenient way to set up your tests. Call this and Test::Builder
will print the appropriate headers and take the appropriate actions.
If you call plan(), don't call any of the other methods below.
=cut
sub plan {
my($self, $cmd, $arg) = @_;
return unless $cmd;
if( $Have_Plan ) {
die sprintf "You tried to plan twice! Second plan at %s line %d\n",
($self->caller)[1,2];
}
if( $cmd eq 'no_plan' ) {
$self->no_plan;
}
elsif( $cmd eq 'skip_all' ) {
return $self->skip_all($arg);
}
elsif( $cmd eq 'tests' ) {
if( $arg ) {
return $self->expected_tests($arg);
}
elsif( !defined $arg ) {
die "Got an undefined number of tests. Looks like you tried to ".
"say how many tests you plan to run but made a mistake.\n";
}
elsif( !$arg ) {
die "You said to run 0 tests! You've got to run something.\n";
}
}
else {
require Carp;
my @args = grep { defined } ($cmd, $arg);
Carp::croak("plan() doesn't understand @args");
}
return 1;
}
=item B<expected_tests>
my $max = $Test->expected_tests;
$Test->expected_tests($max);
Gets/sets the # of tests we expect this test to run and prints out
the appropriate headers.
=cut
my $Expected_Tests = 0;
sub expected_tests {
my($self, $max) = @_;
if( defined $max ) {
$Expected_Tests = $max;
$Have_Plan = 1;
$self->_print("1..$max\n") unless $self->no_header;
}
return $Expected_Tests;
}
=item B<no_plan>
$Test->no_plan;
Declares that this test will run an indeterminate # of tests.
=cut
my($No_Plan) = 0;
sub no_plan {
$No_Plan = 1;
$Have_Plan = 1;
}
=item B<skip_all>
$Test->skip_all;
$Test->skip_all($reason);
Skips all the tests, using the given $reason. Exits immediately with 0.
=cut
my $Skip_All = 0;
sub skip_all {
my($self, $reason) = @_;
my $out = "1..0";
$out .= " # Skip $reason" if $reason;
$out .= "\n";
$Skip_All = 1;
$self->_print($out) unless $self->no_header;
exit(0);
}
=back
=head2 Running tests
These actually run the tests, analogous to the functions in
Test::More.
$name is always optional.
=over 4
=item B<ok>
$Test->ok($test, $name);
Your basic test. Pass if $test is true, fail if $test is false. Just
like Test::Simple's ok().
=cut
sub ok {
my($self, $test, $name) = @_;
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
}
lock $Curr_Test;
$Curr_Test++;
$self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
You named your test '$name'. You shouldn't use numbers for your test names.
Very confusing.
ERR
my($pack, $file, $line) = $self->caller;
my $todo = $self->todo($pack);
my $out;
unless( $test ) {
$out .= "not ";
$Test_Results[$Curr_Test-1] = $todo ? 1 : 0;
}
else {
$Test_Results[$Curr_Test-1] = 1;
}
$out .= "ok";
$out .= " $Curr_Test" if $self->use_numbers;
if( defined $name ) {
$name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
$out .= " - $name";
}
if( $todo ) {
my $what_todo = $todo;
$out .= " # TODO $what_todo";
}
$out .= "\n";
$self->_print($out);
unless( $test ) {
my $msg = $todo ? "Failed (TODO)" : "Failed";
$self->diag(" $msg test ($file at line $line)\n");
}
return $test ? 1 : 0;
}
=item B<is_eq>
$Test->is_eq($got, $expected, $name);
Like Test::More's is(). Checks if $got eq $expected. This is the
string version.
=item B<is_num>
$Test->is_num($got, $expected, $name);
Like Test::More's is(). Checks if $got == $expected. This is the
numeric version.
=cut
sub is_eq {
my($self, $got, $expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok($test, $name);
$self->_is_diag($got, 'eq', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, 'eq', $expect, $name);
}
sub is_num {
my($self, $got, $expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
$self->ok($test, $name);
$self->_is_diag($got, '==', $expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '==', $expect, $name);
}
sub _is_diag {
my($self, $got, $type, $expect) = @_;
foreach my $val (\$got, \$expect) {
if( defined $$val ) {
if( $type eq 'eq' ) {
# quote and force string context
$$val = "'$$val'"
}
else {
# force numeric context
$$val = $$val+0;
}
}
else {
$$val = 'undef';
}
}
return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
got: %s
expected: %s
DIAGNOSTIC
}
=item B<isnt_eq>
$Test->isnt_eq($got, $dont_expect, $name);
Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
the string version.
=item B<isnt_num>
$Test->is_num($got, $dont_expect, $name);
Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
the numeric version.
=cut
sub isnt_eq {
my($self, $got, $dont_expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
$self->_cmp_diag('ne', $got, $dont_expect) unless $test;
return $test;
}
return $self->cmp_ok($got, 'ne', $dont_expect, $name);
}
sub isnt_num {
my($self, $got, $dont_expect, $name) = @_;
local $Level = $Level + 1;
if( !defined $got || !defined $dont_expect ) {
# undef only matches undef and nothing else
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
$self->_cmp_diag('!=', $got, $dont_expect) unless $test;
return $test;
}
return $self->cmp_ok($got, '!=', $dont_expect, $name);
}
=item B<like>
$Test->like($this, qr/$regex/, $name);
$Test->like($this, '/$regex/', $name);
Like Test::More's like(). Checks if $this matches the given $regex.
You'll want to avoid qr// if you want your tests to work before 5.005.
=item B<unlike>
$Test->unlike($this, qr/$regex/, $name);
$Test->unlike($this, '/$regex/', $name);
Like Test::More's unlike(). Checks if $this B<does not match> the
given $regex.
=cut
sub like {
my($self, $this, $regex, $name) = @_;
local $Level = $Level + 1;
$self->_regex_ok($this, $regex, '=~', $name);
}
sub unlike {
my($self, $this, $regex, $name) = @_;
local $Level = $Level + 1;
$self->_regex_ok($this, $regex, '!~', $name);
}
=item B<maybe_regex>
$Test->maybe_regex(qr/$regex/);
$Test->maybe_regex('/$regex/');
Convenience method for building testing functions that take regular
expressions as arguments, but need to work before perl 5.005.
Takes a quoted regular expression produced by qr//, or a string
representing a regular expression.
Returns a Perl value which may be used instead of the corresponding
regular expression, or undef if it's argument is not recognised.
For example, a version of like(), sans the useful diagnostic messages,
could be written as:
sub laconic_like {
my ($self, $this, $regex, $name) = @_;
my $usable_regex = $self->maybe_regex($regex);
die "expecting regex, found '$regex'\n"
unless $usable_regex;
$self->ok($this =~ m/$usable_regex/, $name);
}
=cut
sub maybe_regex {
my ($self, $regex) = @_;
my $usable_regex = undef;
if( ref $regex eq 'Regexp' ) {
$usable_regex = $regex;
}
# Check if it looks like '/foo/'
elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
$usable_regex = length $opts ? "(?$opts)$re" : $re;
};
return($usable_regex)
};
sub _regex_ok {
my($self, $this, $regex, $cmp, $name) = @_;
local $Level = $Level + 1;
my $ok = 0;
my $usable_regex = $self->maybe_regex($regex);
unless (defined $usable_regex) {
$ok = $self->ok( 0, $name );
$self->diag(" '$regex' doesn't look much like a regex to me.");
return $ok;
}
{
local $^W = 0;
my $test = $this =~ /$usable_regex/ ? 1 : 0;
$test = !$test if $cmp eq '!~';
$ok = $self->ok( $test, $name );
}
unless( $ok ) {
$this = defined $this ? "'$this'" : 'undef';
my $match = $cmp eq '=~' ? "doesn't match" : "matches";
$self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
%s
%13s '%s'
DIAGNOSTIC
}
return $ok;
}
=item B<cmp_ok>
$Test->cmp_ok($this, $type, $that, $name);
Works just like Test::More's cmp_ok().
$Test->cmp_ok($big_num, '!=', $other_big_num);
=cut
sub cmp_ok {
my($self, $got, $type, $expect, $name) = @_;
my $test;
{
local $^W = 0;
local($@,$!); # don't interfere with $@
# eval() sometimes resets $!
$test = eval "\$got $type \$expect";
}
local $Level = $Level + 1;
my $ok = $self->ok($test, $name);
unless( $ok ) {
if( $type =~ /^(eq|==)$/ ) {
$self->_is_diag($got, $type, $expect);
}
else {
$self->_cmp_diag($got, $type, $expect);
}
}
return $ok;
}
sub _cmp_diag {
my($self, $got, $type, $expect) = @_;
$got = defined $got ? "'$got'" : 'undef';
$expect = defined $expect ? "'$expect'" : 'undef';
return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
%s
%s
%s
DIAGNOSTIC
}
=item B<BAILOUT>
$Test->BAILOUT($reason);
Indicates to the Test::Harness that things are going so badly all
testing should terminate. This includes running any additional test
scripts.
It will exit with 255.
=cut
sub BAILOUT {
my($self, $reason) = @_;
$self->_print("Bail out! $reason");
exit 255;
}
=item B<skip>
$Test->skip;
$Test->skip($why);
Skips the current test, reporting $why.
=cut
sub skip {
my($self, $why) = @_;
$why ||= '';
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
}
lock($Curr_Test);
$Curr_Test++;
$Test_Results[$Curr_Test-1] = 1;
my $out = "ok";
$out .= " $Curr_Test" if $self->use_numbers;
$out .= " # skip $why\n";
$Test->_print($out);
return 1;
}
=item B<todo_skip>
$Test->todo_skip;
$Test->todo_skip($why);
Like skip(), only it will declare the test as failing and TODO. Similar
to
print "not ok $tnum # TODO $why\n";
=cut
sub todo_skip {
my($self, $why) = @_;
$why ||= '';
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
}
lock($Curr_Test);
$Curr_Test++;
$Test_Results[$Curr_Test-1] = 1;
my $out = "not ok";
$out .= " $Curr_Test" if $self->use_numbers;
$out .= " # TODO & SKIP $why\n";
$Test->_print($out);
return 1;
}
=begin _unimplemented
=item B<skip_rest>
$Test->skip_rest;
$Test->skip_rest($reason);
Like skip(), only it skips all the rest of the tests you plan to run
and terminates the test.
If you're running under no_plan, it skips once and terminates the
test.
=end _unimplemented
=back
=head2 Test style
=over 4
=item B<level>
$Test->level($how_high);
How far up the call stack should $Test look when reporting where the
test failed.
Defaults to 1.
Setting $Test::Builder::Level overrides. This is typically useful
localized:
{
local $Test::Builder::Level = 2;
$Test->ok($test);
}
=cut
sub level {
my($self, $level) = @_;
if( defined $level ) {
$Level = $level;
}
return $Level;
}
$CLASS->level(1);
=item B<use_numbers>
$Test->use_numbers($on_or_off);
Whether or not the test should output numbers. That is, this if true:
ok 1
ok 2
ok 3
or this if false
ok
ok
ok
Most useful when you can't depend on the test output order, such as
when threads or forking is involved.
Test::Harness will accept either, but avoid mixing the two styles.
Defaults to on.
=cut
my $Use_Nums = 1;
sub use_numbers {
my($self, $use_nums) = @_;
if( defined $use_nums ) {
$Use_Nums = $use_nums;
}
return $Use_Nums;
}
=item B<no_header>
$Test->no_header($no_header);
If set to true, no "1..N" header will be printed.
=item B<no_ending>
$Test->no_ending($no_ending);
Normally, Test::Builder does some extra diagnostics when the test
ends. It also changes the exit code as described in Test::Simple.
If this is true, none of that will be done.
=cut
my($No_Header, $No_Ending) = (0,0);
sub no_header {
my($self, $no_header) = @_;
if( defined $no_header ) {
$No_Header = $no_header;
}
return $No_Header;
}
sub no_ending {
my($self, $no_ending) = @_;
if( defined $no_ending ) {
$No_Ending = $no_ending;
}
return $No_Ending;
}
=back
=head2 Output
Controlling where the test output goes.
It's ok for your test to change where STDOUT and STDERR point to,
Test::Builder's default output settings will not be affected.
=over 4
=item B<diag>
$Test->diag(@msgs);
Prints out the given $message. Normally, it uses the failure_output()
handle, but if this is for a TODO test, the todo_output() handle is
used.
Output will be indented and marked with a # so as not to interfere
with test output. A newline will be put on the end if there isn't one
already.
We encourage using this rather than calling print directly.
Returns false. Why? Because diag() is often used in conjunction with
a failing test (C<ok() || diag()>) it "passes through" the failure.
return ok(...) || diag(...);
=for blame transfer
Mark Fowler <mark@twoshortplanks.com>
=cut
sub diag {
my($self, @msgs) = @_;
return unless @msgs;
# Prevent printing headers when compiling (i.e. -c)
return if $^C;
# Escape each line with a #.
foreach (@msgs) {
$_ = 'undef' unless defined;
s/^/# /gms;
}
push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
local $Level = $Level + 1;
my $fh = $self->todo ? $self->todo_output : $self->failure_output;
local($\, $", $,) = (undef, ' ', '');
print $fh @msgs;
return 0;
}
=begin _private
=item B<_print>
$Test->_print(@msgs);
Prints to the output() filehandle.
=end _private
=cut
sub _print {
my($self, @msgs) = @_;
# Prevent printing headers when only compiling. Mostly for when
# tests are deparsed with B::Deparse
return if $^C;
local($\, $", $,) = (undef, ' ', '');
my $fh = $self->output;
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
foreach (@msgs) {
s/\n(.)/\n# $1/sg;
}
push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
print $fh @msgs;
}
=item B<output>
$Test->output($fh);
$Test->output($file);
Where normal "ok/not ok" test output should go.
Defaults to STDOUT.
=item B<failure_output>
$Test->failure_output($fh);
$Test->failure_output($file);
Where diagnostic output on test failures and diag() should go.
Defaults to STDERR.
=item B<todo_output>
$Test->todo_output($fh);
$Test->todo_output($file);
Where diagnostics about todo test failures and diag() should go.
Defaults to STDOUT.
=cut
my($Out_FH, $Fail_FH, $Todo_FH);
sub output {
my($self, $fh) = @_;
if( defined $fh ) {
$Out_FH = _new_fh($fh);
}
return $Out_FH;
}
sub failure_output {
my($self, $fh) = @_;
if( defined $fh ) {
$Fail_FH = _new_fh($fh);
}
return $Fail_FH;
}
sub todo_output {
my($self, $fh) = @_;
if( defined $fh ) {
$Todo_FH = _new_fh($fh);
}
return $Todo_FH;
}
sub _new_fh {
my($file_or_fh) = shift;
my $fh;
unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
$fh = do { local *FH };
open $fh, ">$file_or_fh" or
die "Can't open test output log $file_or_fh: $!";
}
else {
$fh = $file_or_fh;
}
return $fh;
}
unless( $^C ) {
# We dup STDOUT and STDERR so people can change them in their
# test suites while still getting normal test output.
open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
# Set everything to unbuffered else plain prints to STDOUT will
# come out in the wrong order from our own prints.
_autoflush(\*TESTOUT);
_autoflush(\*STDOUT);
_autoflush(\*TESTERR);
_autoflush(\*STDERR);
$CLASS->output(\*TESTOUT);
$CLASS->failure_output(\*TESTERR);
$CLASS->todo_output(\*TESTOUT);
}
sub _autoflush {
my($fh) = shift;
my $old_fh = select $fh;
$| = 1;
select $old_fh;
}
=back
=head2 Test Status and Info
=over 4
=item B<current_test>
my $curr_test = $Test->current_test;
$Test->current_test($num);
Gets/sets the current test # we're on.
You usually shouldn't have to set this.
=cut
sub current_test {
my($self, $num) = @_;
lock($Curr_Test);
if( defined $num ) {
unless( $Have_Plan ) {
require Carp;
Carp::croak("Can't change the current test number without a plan!");
}
$Curr_Test = $num;
if( $num > @Test_Results ) {
my $start = @Test_Results ? $#Test_Results : 0;
for ($start..$num-1) {
$Test_Results[$_] = 1;
}
}
}
return $Curr_Test;
}
=item B<summary>
my @tests = $Test->summary;
A simple summary of the tests so far. True for pass, false for fail.
This is a logical pass/fail, so todos are passes.
Of course, test #1 is $tests[0], etc...
=cut
sub summary {
my($self) = shift;
return @Test_Results;
}
=item B<details> I<UNIMPLEMENTED>
my @tests = $Test->details;
Like summary(), but with a lot more detail.
$tests[$test_num - 1] =
{ ok => is the test considered ok?
actual_ok => did it literally say 'ok'?
name => name of the test (if any)
type => 'skip' or 'todo' (if any)
reason => reason for the above (if any)
};
=item B<todo>
my $todo_reason = $Test->todo;
my $todo_reason = $Test->todo($pack);
todo() looks for a $TODO variable in your tests. If set, all tests
will be considered 'todo' (see Test::More and Test::Harness for
details). Returns the reason (ie. the value of $TODO) if running as
todo tests, false otherwise.
todo() is pretty part about finding the right package to look for
$TODO in. It uses the exported_to() package to find it. If that's
not set, it's pretty good at guessing the right package to look at.
Sometimes there is some confusion about where todo() should be looking
for the $TODO variable. If you want to be sure, tell it explicitly
what $pack to use.
=cut
sub todo {
my($self, $pack) = @_;
$pack = $pack || $self->exported_to || $self->caller(1);
no strict 'refs';
return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
: 0;
}
=item B<caller>
my $package = $Test->caller;
my($pack, $file, $line) = $Test->caller;
my($pack, $file, $line) = $Test->caller($height);
Like the normal caller(), except it reports according to your level().
=cut
sub caller {
my($self, $height) = @_;
$height ||= 0;
my @caller = CORE::caller($self->level + $height + 1);
return wantarray ? @caller : $caller[0];
}
=back
=cut
=begin _private
=over 4
=item B<_sanity_check>
_sanity_check();
Runs a bunch of end of test sanity checks to make sure reality came
through ok. If anything is wrong it will die with a fairly friendly
error message.
=cut
#'#
sub _sanity_check {
_whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
_whoa(!$Have_Plan and $Curr_Test,
'Somehow your tests ran without a plan!');
_whoa($Curr_Test != @Test_Results,
'Somehow you got a different number of results than tests ran!');
}
=item B<_whoa>
_whoa($check, $description);
A sanity check, similar to assert(). If the $check is true, something
has gone horribly wrong. It will die with the given $description and
a note to contact the author.
=cut
sub _whoa {
my($check, $desc) = @_;
if( $check ) {
die <<WHOA;
WHOA! $desc
This should never happen! Please contact the author immediately!
WHOA
}
}
=item B<_my_exit>
_my_exit($exit_num);
Perl seems to have some trouble with exiting inside an END block. 5.005_03
and 5.6.1 both seem to do odd things. Instead, this function edits $?
directly. It should ONLY be called from inside an END block. It
doesn't actually exit, that's your job.
=cut
sub _my_exit {
$? = $_[0];
return 1;
}
=back
=end _private
=cut
$SIG{__DIE__} = sub {
# We don't want to muck with death in an eval, but $^S isn't
# totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
# with it. Instead, we use caller. This also means it runs under
# 5.004!
my $in_eval = 0;
for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
$in_eval = 1 if $sub =~ /^\(eval\)/;
}
$Test_Died = 1 unless $in_eval;
};
sub _ending {
my $self = shift;
_sanity_check();
# Bailout if plan() was never called. This is so
# "require Test::Simple" doesn't puke.
do{ _my_exit(0) && return } if !$Have_Plan;
# Figure out if we passed or failed and print helpful messages.
if( @Test_Results ) {
# The plan? We have no plan.
if( $No_Plan ) {
$self->_print("1..$Curr_Test\n") unless $self->no_header;
$Expected_Tests = $Curr_Test;
}
# 5.8.0 threads bug. Shared arrays will not be auto-extended
# by a slice.
$Test_Results[$Expected_Tests-1] = undef
unless defined $Test_Results[$Expected_Tests-1];
my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
$num_failed += abs($Expected_Tests - @Test_Results);
if( $Curr_Test < $Expected_Tests ) {
$self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
FAIL
}
elsif( $Curr_Test > $Expected_Tests ) {
my $num_extra = $Curr_Test - $Expected_Tests;
$self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but ran $num_extra extra.
FAIL
}
elsif ( $num_failed ) {
$self->diag(<<"FAIL");
Looks like you failed $num_failed tests of $Expected_Tests.
FAIL
}
if( $Test_Died ) {
$self->diag(<<"FAIL");
Looks like your test died just after $Curr_Test.
FAIL
_my_exit( 255 ) && return;
}
_my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
}
elsif ( $Skip_All ) {
_my_exit( 0 ) && return;
}
else {
$self->diag("No tests run!\n");
_my_exit( 255 ) && return;
}
}
END {
$Test->_ending if defined $Test and !$Test->no_ending;
}
=head1 THREADS
In perl 5.8.0 and later, Test::Builder is thread-safe. The test
number is shared amongst all threads. This means if one thread sets
the test number using current_test() they will all be effected.
=head1 EXAMPLES
CPAN can provide the best examples. Test::Simple, Test::More,
Test::Exception and Test::Differences all use Test::Builder.
=head1 SEE ALSO
Test::Simple, Test::More, Test::Harness
=head1 AUTHORS
Original code by chromatic, maintained by Michael G Schwern
E<lt>schwern@pobox.comE<gt>
=head1 COPYRIGHT
Copyright 2001 by chromatic E<lt>chromatic@wgz.orgE<gt>,
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;
Exporter-Tidy-0.07/t/lib/Test/More.pm 0000644 0000000 0000000 00000074476 11600156501 0017362 0 ustar 00root root 0000000 0000000 package Test::More;
use 5.004;
use strict;
use Test::Builder;
# 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];
warn @_, " at $file line $line\n";
}
require Exporter;
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
$VERSION = '0.45';
@ISA = qw(Exporter);
@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
can_ok isa_ok
diag
);
my $Test = Test::Builder->new;
# 5.004's Exporter doesn't have export_to_level.
sub _export_to_level
{
my $pkg = shift;
my $level = shift;
(undef) = shift; # redundant arg
my $callpkg = caller($level);
$pkg->export($callpkg, @_);
}
=head1 NAME
Test::More - yet another framework for writing test scripts
=head1 SYNOPSIS
use Test::More tests => $Num_Tests;
# or
use Test::More qw(no_plan);
# or
use Test::More skip_all => $reason;
BEGIN { use_ok( 'Some::Module' ); }
require_ok( 'Some::Module' );
# Various ways to say "ok"
ok($this eq $that, $test_name);
is ($this, $that, $test_name);
isnt($this, $that, $test_name);
# Rather than print STDERR "# here's what went wrong\n"
diag("here's what went wrong");
like ($this, qr/that/, $test_name);
unlike($this, qr/that/, $test_name);
cmp_ok($this, '==', $that, $test_name);
is_deeply($complex_structure1, $complex_structure2, $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);
# Utility comparison functions.
eq_array(\@this, \@that);
eq_hash(\%this, \%that);
eq_set(\@this, \@that);
# UNIMPLEMENTED!!!
my @status = Test::More::status;
# UNIMPLEMENTED!!!
BAIL_OUT($why);
=head1 DESCRIPTION
B<STOP!> If you're just getting started writing tests, have a look at
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 => $Num_Tests;
There are rare cases when you will not know beforehand how many tests
your script is going to run. In this case, you can declare that you
have no plan. (Try to avoid using this as it weakens your test.)
use Test::More qw(no_plan);
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(@plan) = @_;
my $caller = caller;
$Test->exported_to($caller);
my @imports = ();
foreach my $idx (0..$#plan) {
if( $plan[$idx] eq 'import' ) {
my($tag, $imports) = splice @plan, $idx, 2;
@imports = @$imports;
last;
}
}
$Test->plan(@plan);
__PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
}
sub import {
my($class) = shift;
goto &plan;
}
=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($this eq $that, $test_name);
This simply evaluates any expression (C<$this eq $that> 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 18 (foo.t at line 42)
This is actually Test::Simple's ok() routine.
=cut
sub ok ($;$) {
my($test, $name) = @_;
$Test->ok($test, $name);
}
=item B<is>
=item B<isnt>
is ( $this, $that, $test_name );
isnt( $this, $that, $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" );
(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 1 (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! $pope->isa('Catholic') eq 1
is( $pope->isa('Catholic'), 1, 'Is the Pope Catholic?' );
This does not check if C<$pope->isa('Catholic')> is true, it checks if
it returns 1. Very different. Similar caveats exist for false and 0.
In these cases, use ok().
ok( $pope->isa('Catholic') ), 'Is the Pope Catholic?' );
For those grammatical pedants out there, there's an C<isn't()>
function which is an alias of isnt().
=cut
sub is ($$;$) {
$Test->is_eq(@_);
}
sub isnt ($$;$) {
$Test->isnt_eq(@_);
}
*isn't = \&isnt;
=item B<like>
like( $this, qr/that/, $test_name );
Similar to ok(), like() matches $this against the regex C<qr/that/>.
So this:
like($this, qr/that/, 'this is like that');
is similar to:
ok( $this =~ /that/, '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( $this, '/that/', 'this is like that' );
Regex options may be placed on the end (C<'/that/i'>).
Its advantages over ok() are similar to that of is() and isnt(). Better
diagnostics on failure.
=cut
sub like ($$;$) {
$Test->like(@_);
}
=item B<unlike>
unlike( $this, qr/that/, $test_name );
Works exactly as like(), only it checks if $this B<does not> match the
given pattern.
=cut
sub unlike {
$Test->unlike(@_);
}
=item B<cmp_ok>
cmp_ok( $this, $op, $that, $test_name );
Halfway between ok() and is() lies cmp_ok(). This allows you to
compare two arguments using any binary perl operator.
# ok( $this eq $that );
cmp_ok( $this, 'eq', $that, 'this eq that' );
# ok( $this == $that );
cmp_ok( $this, '==', $that, 'this == that' );
# ok( $this && $that );
cmp_ok( $this, '&&', $that, 'this || that' );
...etc...
Its advantage over ok() is when the test fails you'll know what $this
and $that were:
not ok 1
# Failed test (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 );
=cut
sub cmp_ok($$$;$) {
$Test->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;
unless( @methods ) {
my $ok = $Test->ok( 0, "$class->can(...)" );
$Test->diag(' can_ok() called with no methods');
return $ok;
}
my @nok = ();
foreach my $method (@methods) {
local($!, $@); # don't interfere with caller's $@
# eval sometimes resets $!
eval { $proto->can($method) } || push @nok, $method;
}
my $name;
$name = @methods == 1 ? "$class->can('$methods[0]')"
: "$class->can(...)";
my $ok = $Test->ok( !@nok, $name );
$Test->diag(map " $class->can('$_') failed\n", @nok);
return $ok;
}
=item B<isa_ok>
isa_ok($object, $class, $object_name);
isa_ok($ref, $type, $ref_name);
Checks to see if the given $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.
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 $diag;
$obj_name = 'The object' unless defined $obj_name;
my $name = "$obj_name isa $class";
if( !defined $object ) {
$diag = "$obj_name isn't defined";
}
elsif( !ref $object ) {
$diag = "$obj_name isn't a reference";
}
else {
# We can't use UNIVERSAL::isa because we want to honor isa() overrides
local($@, $!); # eval sometimes resets $!
my $rslt = eval { $object->isa($class) };
if( $@ ) {
if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
if( !UNIVERSAL::isa($object, $class) ) {
my $ref = ref $object;
$diag = "$obj_name isn't a '$class' it's a '$ref'";
}
} else {
die <<WHOA;
WHOA! I tried to call ->isa on your object and got some weird error.
This should never happen. Please contact the author immediately.
Here's the error.
$@
WHOA
}
}
elsif( !$rslt ) {
my $ref = ref $object;
$diag = "$obj_name isn't a '$class' it's a '$ref'";
}
}
my $ok;
if( $diag ) {
$ok = $Test->ok( 0, $name );
$Test->diag(" $diag\n");
}
else {
$ok = $Test->ok( 1, $name );
}
return $ok;
}
=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 (;$) {
$Test->ok(1, @_);
}
sub fail (;$) {
$Test->ok(0, @_);
}
=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. 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 (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.
=cut
sub diag {
$Test->diag(@_);
}
=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);
don't try to do this:
BEGIN {
use_ok('Some::Module');
...some code that depends on the use...
...happening at compile time...
}
instead, you want:
BEGIN { use_ok('Some::Module') }
BEGIN { ...some code that depends on the use... }
=cut
sub use_ok ($;@) {
my($module, @imports) = @_;
@imports = () unless @imports;
my $pack = caller;
local($@,$!); # eval sometimes interferes with $!
eval <<USE;
package $pack;
require $module;
'$module'->import(\@imports);
USE
my $ok = $Test->ok( !$@, "use $module;" );
unless( $ok ) {
chomp $@;
$Test->diag(<<DIAGNOSTIC);
Tried to use '$module'.
Error: $@
DIAGNOSTIC
}
return $ok;
}
=item B<require_ok>
require_ok($module);
Like use_ok(), except it requires the $module.
=cut
sub require_ok ($) {
my($module) = shift;
my $pack = caller;
local($!, $@); # eval sometimes interferes with $!
eval <<REQUIRE;
package $pack;
require $module;
REQUIRE
my $ok = $Test->ok( !$@, "require $module;" );
unless( $ok ) {
chomp $@;
$Test->diag(<<DIAGNOSTIC);
Tried to require '$module'.
Error: $@
DIAGNOSTIC
}
return $ok;
}
=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;
ok( $lint, "Created object" );
$lint->parse( $html );
is( scalar $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.
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
#'#
sub skip {
my($why, $how_many) = @_;
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 $Test::Builder::No_Plan;
$how_many = 1;
}
for( 1..$how_many ) {
$Test->skip($why);
}
local $^W = 0;
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) = @_;
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 $Test::Builder::No_Plan;
$how_many = 1;
}
for( 1..$how_many ) {
$Test->todo_skip($why);
}
local $^W = 0;
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 Comparison functions
Not everything is a simple eq check or regex. There are times you
need to see if two arrays are equivalent, for instance. For these
instances, Test::More provides a handful of useful functions.
B<NOTE> These are NOT well-tested on circular references. Nor am I
quite sure what will happen with filehandles.
=over 4
=item B<is_deeply>
is_deeply( $this, $that, $test_name );
Similar to is(), except that if $this and $that are hash or array
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.
Barrie Slaymaker's Test::Differences module provides more in-depth
functionality along these lines, and it plays well with Test::More.
B<NOTE> Display of scalar refs is not quite 100%
=cut
use vars qw(@Data_Stack);
my $DNE = bless [], 'Does::Not::Exist';
sub is_deeply {
my($this, $that, $name) = @_;
my $ok;
if( !ref $this || !ref $that ) {
$ok = $Test->is_eq($this, $that, $name);
}
else {
local @Data_Stack = ();
if( _deep_check($this, $that) ) {
$ok = $Test->ok(1, $name);
}
else {
$ok = $Test->ok(0, $name);
$ok = $Test->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' :
$val eq $DNE ? "Does not exist"
: "'$val'";
}
$out .= "$vars[0] = $vals[0]\n";
$out .= "$vars[1] = $vals[1]\n";
$out =~ s/^/ /msg;
return $out;
}
=item B<eq_array>
eq_array(\@this, \@that);
Checks if two arrays are equivalent. This is a deep check, so
multi-level structures are handled correctly.
=cut
#'#
sub eq_array {
my($a1, $a2) = @_;
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->[$_];
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 _deep_check {
my($e1, $e2) = @_;
my $ok = 0;
my $eq;
{
# Quiet uninitialized value warnings when comparing undefs.
local $^W = 0;
if( $e1 eq $e2 ) {
$ok = 1;
}
else {
if( UNIVERSAL::isa($e1, 'ARRAY') and
UNIVERSAL::isa($e2, 'ARRAY') )
{
$ok = eq_array($e1, $e2);
}
elsif( UNIVERSAL::isa($e1, 'HASH') and
UNIVERSAL::isa($e2, 'HASH') )
{
$ok = eq_hash($e1, $e2);
}
elsif( UNIVERSAL::isa($e1, 'REF') and
UNIVERSAL::isa($e2, 'REF') )
{
push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
$ok = _deep_check($$e1, $$e2);
pop @Data_Stack if $ok;
}
elsif( UNIVERSAL::isa($e1, 'SCALAR') and
UNIVERSAL::isa($e2, 'SCALAR') )
{
push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
$ok = _deep_check($$e1, $$e2);
}
else {
push @Data_Stack, { vals => [$e1, $e2] };
$ok = 0;
}
}
}
return $ok;
}
=item B<eq_hash>
eq_hash(\%this, \%that);
Determines if the two hashes contain the same keys and values. This
is a deep check.
=cut
sub eq_hash {
my($a1, $a2) = @_;
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;
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>
eq_set(\@this, \@that);
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.
=cut
# We must make sure that references are treated neutrally. It really
# doesn't matter how we sort them, as long as both arrays are sorted
# with the same algorithm.
sub _bogus_sort { local $^W = 0; ref $a ? 0 : $a cmp $b }
sub eq_set {
my($a1, $a2) = @_;
return 0 unless @$a1 == @$a2;
# There's faster ways to do this, but this is easiest.
return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$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.
=cut
sub builder {
return Test::Builder->new;
}
=back
=head1 NOTES
Test::More is B<explicitly> tested all the way back to perl 5.004.
Test::More is thread-safe for perl 5.8.0 and up.
=head1 BUGS and CAVEATS
=over 4
=item Making your own ok()
If you are trying to extend Test::More, don't. Use Test::Builder
instead.
=item The eq_* family has some caveats.
=item Test::Harness upgrades
no_plan and todo depend on new Test::Harness features and fixes. If
you're going to distribute tests that use no_plan or todo your
end-users will have to upgrade Test::Harness to the latest one on
CPAN. If you avoid no_plan and TODO tests, the stock Test::Harness
will work fine.
If you simply depend on Test::More, it's own dependencies will cause a
Test::Harness upgrade.
=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::Differences> for more ways to test complex data structures.
And it plays well with Test::More.
L<Test> is the old testing module. Its main benefit is that it has
been distributed with Perl since 5.004_05.
L<Test::Harness> for details on how your test results are interpreted
by Perl.
L<Test::Unit> describes a very featureful unit testing interface.
L<Test::Inline> shows the idea of embedded testing.
L<SelfTest> is another approach to embedded testing.
=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, chromatic and the perl-qa gang.
=head1 COPYRIGHT
Copyright 2001 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;