package Test::More;
-use strict;
+use 5.004;
+use strict;
+use Test::Builder;
-# Special print function to guard against $\ and -l munging.
-sub _print (*@) {
- my($fh, @args) = @_;
- local $\;
- print $fh @args;
+# 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 @_, sprintf " at $file line $line\n";
}
-sub print { die "DON'T USE PRINT! Use _print instead" }
-
-BEGIN {
- require Test::Simple;
- *TESTOUT = \*Test::Simple::TESTOUT;
- *TESTERR = \*Test::Simple::TESTERR;
-}
require Exporter;
-use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.07';
+use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
+$VERSION = '0.33';
@ISA = qw(Exporter);
@EXPORT = qw(ok use_ok require_ok
- is isnt like
+ is isnt like is_deeply
skip todo
pass fail
eq_array eq_hash eq_set
+ $TODO
+ plan
+ can_ok isa_ok
);
+my $Test = Test::Builder->new;
-sub import {
- my($class, $plan, @args) = @_;
-
- if( $plan eq 'skip_all' ) {
- $Test::Simple::Skip_All = 1;
- _print *TESTOUT, "1..0\n";
- exit(0);
- }
- else {
- Test::Simple->import($plan => @args);
- }
-
- __PACKAGE__->_export_to_level(1, __PACKAGE__);
-}
# 5.004's Exporter doesn't have export_to_level.
sub _export_to_level
# or
use Test::More qw(no_plan);
# or
- use Test::More qw(skip_all);
+ use Test::More skip_all => $reason;
BEGIN { use_ok( 'Some::Module' ); }
require_ok( 'Some::Module' );
isnt($this, $that, $test_name);
like($this, qr/that/, $test_name);
- skip { # UNIMPLEMENTED!!!
+ 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 );
- } $how_many, $why;
+ };
+
+ TODO: {
+ local $TODO = $why;
- todo { # UNIMPLEMENTED!!!
ok( foo(), $test_name );
is( foo(42), 23, $test_name );
- } $how_many, $why;
+ };
+
+ can_ok($module, @methods);
+ isa_ok($object, $class);
pass($test_name);
fail($test_name);
# UNIMPLEMENTED!!!
my @status = Test::More::status;
+ # UNIMPLEMENTED!!!
+ BAIL_OUT($why);
+
=head1 DESCRIPTION
If you're just getting started writing tests, have a look at
-Test::Simple first.
+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.
This module provides a very wide range of testing utilities. Various
ways to say "ok", facilities to skip tests, test future features
how many tests your script is going to run to protect against premature
failure.
-The prefered way to do this is to declare a plan when you C<use Test::More>.
+The preferred way to do this is to declare a plan when you C<use Test::More>.
use Test::More tests => $Num_Tests;
In some cases, you'll want to completely skip an entire testing script.
- use Test::More qw(skip_all);
+ 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;
+ }
-Your script will declare a skip and exit immediately with a zero
-(success). L<Test::Harness> for details.
+=cut
+
+sub plan {
+ my(@plan) = @_;
+
+ my $caller = caller;
+
+ $Test->exported_to($caller);
+ $Test->plan(@plan);
+
+ my @imports = ();
+ foreach my $idx (0..$#plan) {
+ if( $plan[$idx] eq 'import' ) {
+ @imports = @{$plan[$idx+1]};
+ last;
+ }
+ }
+
+ __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
+}
+
+sub import {
+ my($class) = shift;
+ goto &plan;
+}
=head2 Test names
=cut
-# We get ok() from Test::Simple's import().
+sub ok ($;$) {
+ my($test, $name) = @_;
+ $Test->ok($test, $name);
+}
=item B<is>
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:
+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" );
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:
+test:
my $foo = 'waffle'; my $bar = 'yarblokos';
is( $foo, $bar, 'Is foo the same as bar?' );
ok( $pope->isa('Catholic') ), 'Is the Pope Catholic?' );
-For those grammatical pedants out there, there's an isn't() function
-which is an alias of isnt().
+For those grammatical pedants out there, there's an C<isn't()>
+function which is an alias of isnt().
=cut
sub is ($$;$) {
- my($this, $that, $name) = @_;
-
- my $ok = @_ == 3 ? ok($this eq $that, $name)
- : ok($this eq $that);
-
- unless( $ok ) {
- _print *TESTERR, <<DIAGNOSTIC;
-# got: '$this'
-# expected: '$that'
-DIAGNOSTIC
-
- }
-
- return $ok;
+ $Test->is_eq(@_);
}
sub isnt ($$;$) {
my($this, $that, $name) = @_;
- my $ok = @_ == 3 ? ok($this ne $that, $name)
- : ok($this ne $that);
+ my $test;
+ {
+ local $^W = 0; # so isnt(undef, undef) works quietly.
+ $test = $this ne $that;
+ }
+
+ my $ok = $Test->ok($test, $name);
unless( $ok ) {
- _print *TESTERR, <<DIAGNOSTIC;
-# it should not be '$that'
-# but it is.
+ $that = defined $that ? "'$that'" : 'undef';
+
+ $Test->diag(sprintf <<DIAGNOSTIC, $that);
+it should not be %s
+but it is.
DIAGNOSTIC
}
(Mnemonic "This is like that".)
The second argument is a regular expression. It may be given as a
-regex reference (ie. qr//) or (for better compatibility with older
+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):
=cut
sub like ($$;$) {
- my($this, $regex, $name) = @_;
+ $Test->like(@_);
+}
- my $ok = 0;
- if( ref $regex eq 'Regexp' ) {
- $ok = @_ == 3 ? ok( $this =~ $regex ? 1 : 0, $name )
- : ok( $this =~ $regex ? 1 : 0 );
- }
- # Check if it looks like '/foo/i'
- elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
- $ok = @_ == 3 ? ok( $this =~ /(?$opts)$re/ ? 1 : 0, $name )
- : ok( $this =~ /(?$opts)$re/ ? 1 : 0 );
- }
- else {
- # Can't use fail() here, the call stack will be fucked.
- my $ok = @_ == 3 ? ok(0, $name )
- : ok(0);
+=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.
- _print *TESTERR, <<ERR;
-# '$regex' doesn't look much like a regex to me. Failing the test.
-ERR
+=cut
+
+sub can_ok ($@) {
+ my($proto, @methods) = @_;
+ my $class= ref $proto || $proto;
- return $ok;
+ my @nok = ();
+ foreach my $method (@methods) {
+ my $test = "'$class'->can('$method')";
+ eval $test || push @nok, $method;
}
- unless( $ok ) {
- _print *TESTERR, <<DIAGNOSTIC;
-# '$this'
-# doesn't match '$regex'
-DIAGNOSTIC
+ 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);
+
+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.
+
+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";
+ }
+ elsif( !$object->isa($class) ) {
+ $diag = "$obj_name isn't a '$class'";
+ }
+
+ 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>
=cut
-sub pass ($) {
- my($name) = @_;
- return @_ == 1 ? ok(1, $name)
- : ok(1);
+sub pass (;$) {
+ $Test->ok(1, @_);
}
-sub fail ($) {
- my($name) = @_;
- return @_ == 1 ? ok(0, $name)
- : ok(0);
+sub fail (;$) {
+ $Test->ok(0, @_);
}
=back
=item B<use_ok>
-=item B<require_ok>
-
BEGIN { use_ok($module); }
- require_ok($module);
+ BEGIN { use_ok($module, @imports); }
+
+These simply use the given $module and test to make sure the load
+happened ok. Its 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);
-These simply use or require the given $module and test to make sure
-the load happened ok. Its recommended that you run use_ok() inside a
-BEGIN block so its functions are exported at compile-time and
-prototypes are properly honored.
=cut
-sub use_ok ($) {
- my($module) = shift;
+sub use_ok ($;@) {
+ my($module, @imports) = @_;
+ @imports = () unless @imports;
my $pack = caller;
eval <<USE;
package $pack;
require $module;
-$module->import;
+$module->import(\@imports);
USE
- my $ok = ok( !$@, "use $module;" );
+ my $ok = $Test->ok( !$@, "use $module;" );
unless( $ok ) {
- _print *TESTERR, <<DIAGNOSTIC;
-# Tried to use '$module'.
-# Error: $@
+ 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;
require $module;
REQUIRE
- my $ok = ok( !$@, "require $module;" );
+ my $ok = $Test->ok( !$@, "require $module;" );
unless( $ok ) {
- _print *TESTERR, <<DIAGNOSTIC;
+ chomp $@;
+ $Test->diag(<<DIAGNOSTIC);
# Tried to require '$module'.
# Error: $@
DIAGNOSTIC
return $ok;
}
+=back
=head2 Conditional tests
+B<WARNING!> The following describes an I<experimental> interface that
+is subject to change B<WITHOUT NOTICE>! Use at your peril.
+
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 its
-necessary to skip test, or declare that they are supposed to fail
+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 skip and todo tests, L<Test::Harness>.
+For more details on 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> * UNIMPLEMENTED *
+=item B<SKIP: BLOCK>
+
+ SKIP: {
+ skip $why, $how_many if $condition;
+
+ ...normal testing code goes here...
+ }
+
+This declares a block of tests to skip, $how_many tests there are,
+$why and under what $condition to skip them. An example is the
+easiest way to illustrate:
- skip BLOCK $how_many, $why, $if;
+ SKIP: {
+ skip "Pigs don't fly here", 2 unless Pigs->can('fly');
-B<NOTE> Should that be $if or $unless?
+ my $pig = Pigs->new;
+ $pig->takeoff;
-This declares a block of tests to skip, why and under what conditions
-to skip them. An example is the easiest way to illustrate:
+ ok( $pig->altitude > 0, 'Pig is airborne' );
+ ok( $pig->airspeed > 0, ' and moving' );
+ }
+
+If pigs cannot fly, the whole block of tests will be skipped
+completely. Test::More will output special ok's which Test::Harness
+interprets as skipped tests. Its important to include $how_many tests
+are in the block so the total number of tests comes out right (unless
+you're using C<no_plan>, in which case you can leave $how_many off if
+you like).
- skip {
- ok( head("http://www.foo.com"), "www.foo.com is alive" );
- ok( head("http://www.foo.com/bar"), " and has bar" );
- } 2, "LWP::Simple not installed",
- !eval { require LWP::Simple; LWP::Simple->import; 1 };
+You'll typically use this when a feature is missing, like an optional
+module is not installed or the operating system doesn't have some
+feature (like fork() or symlinks) or maybe you need an Internet
+connection and one isn't available.
-The $if condition is optional, but $why is not.
+=for _Future
+See L</Why are skip and todo so weird?>
=cut
+#'#
sub skip {
- die "skip() is UNIMPLEMENTED!";
+ 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> * UNIMPLEMENTED *
- todo BLOCK $how_many, $why;
- todo BLOCK $how_many, $why, $until;
+=item B<TODO: BLOCK>
-Declares a block of tests you expect to fail and why. Perhaps its
-because you haven't fixed a bug:
+ TODO: {
+ local $TODO = $why;
- todo { is( $Gravitational_Constant, 0 ) } 1,
- "Still tinkering with physics --God";
+ ...normal testing code goes here...
+ }
-If you have a set of functionality yet to implement, you can make the
-whole suite dependent on that new feature.
+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 {
- $pig->takeoff;
- ok( $pig->altitude > 0 );
- ok( $pig->mach > 2 );
- ok( $pig->serve_peanuts );
- } 1, "Pigs are still safely grounded",
- Pigs->can('fly');
+ TODO: {
+ local $TODO = "URI::Geller not finished";
-=cut
+ my $card = "Eight of clubs";
+ is( URI::Geller->your_card, $card, 'Is THIS your card?' );
-sub todo {
- die "todo() is UNIMPLEMENTED!";
-}
+ my $spoon;
+ URI::Geller->bend_spoon;
+ is( $spoon, 'bent', "Spoon bending, that's original" );
+ }
-=head2 Comparision functions
+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.
+
+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.
+
+
+=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
=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.
+
+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";
+
+ return $out;
+}
+
+
=item B<eq_array>
eq_array(\@this, \@that);
#'#
sub eq_array {
my($a1, $a2) = @_;
- return 0 unless @$a1 == @$a2;
return 1 if $a1 eq $a2;
my $ok = 1;
- for (0..$#{$a1}) {
- my($e1,$e2) = ($a1->[$_], $a2->[$_]);
+ 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;
my($e1, $e2) = @_;
my $ok = 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);
+ my $eq;
+ {
+ # Quiet uninitialized value warnings when comparing undefs.
+ local $^W = 0;
+
+ if( $e1 eq $e2 ) {
+ $ok = 1;
}
else {
- $ok = 0;
+ 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;
}
sub eq_hash {
my($a1, $a2) = @_;
- return 0 unless keys %$a1 == keys %$a2;
return 1 if $a1 eq $a2;
my $ok = 1;
- foreach my $k (keys %$a1) {
- my($e1, $e2) = ($a1->{$k}, $a2->{$k});
+ 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;
}
# 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 { ref $a ? 0 : $a cmp $b }
+sub _bogus_sort { local $^W = 0; ref $a ? 0 : $a cmp $b }
sub eq_set {
my($a1, $a2) = @_;
=back
+=head1 NOTES
+
+Test::More is B<explicitly> tested all the way back to perl 5.004.
+
=head1 BUGS and CAVEATS
-The eq_* family have some caveats.
+=over 4
-todo() and skip() are unimplemented.
+=item Making your own ok()
-The no_plan feature depends on new Test::Harness feature. If you're going
-to distribute tests that use no_plan your end-users will have to upgrade
-Test::Harness to the latest one on CPAN.
+This will not do what you mean:
-=head1 AUTHOR
+ sub my_ok {
+ ok( @_ );
+ }
-Michael G Schwern <schwern@pobox.com> with much inspiration from
-Joshua Pritikin's Test module and lots of discussion with Barrie
-Slaymaker and the perl-qa gang.
+ my_ok( 2 + 2 == 5, 'Basic addition' );
+
+since ok() takes it's arguments as scalars, it will see the length of
+@_ (2) and always pass the test. You want to do this instead:
+
+ sub my_ok {
+ ok( $_[0], $_[1] );
+ }
+
+The other functions act similarly.
+
+=item The eq_* family have 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 your end-users will
+have to upgrade Test::Harness to the latest one on CPAN.
+
+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 actually largely unware of its existance when I'd first
+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).
L<Test::Unit> describes a very featureful unit testing interface.
-L<Pod::Tests> shows the idea of embedded testing.
+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 discussion with Barrie
+Slaymaker 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 L<http://www.perl.com/perl/misc/Artistic.html>
+
=cut
1;
projects / p5sagit/p5-mst-13.2.git / blobdiff