From: Michael G. Schwern Date: Thu, 10 Jan 2002 19:56:23 +0000 (-0500) Subject: Test::Simple/More/Builder/Tutorial 0.41 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a9153838573937ae6673c59472b70743ddaf741a;p=p5sagit%2Fp5-mst-13.2.git Test::Simple/More/Builder/Tutorial 0.41 Message-ID: <20020111005623.GA13192@blackrider> p4raw-id: //depot/perl@14178 --- diff --git a/MANIFEST b/MANIFEST index b07674b..f50585c 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1278,6 +1278,8 @@ lib/Test/Simple.pm Basic utility for writing tests lib/Test/Simple/Changes Test::Simple changes lib/Test/Simple/README Test::Simple README lib/Test/Simple/t/Builder.t Test::Builder tests +lib/Test/Simple/t/buffer.t Test::Builder buffering test +lib/Test/Simple/t/diag.t Test::More diag() test lib/Test/Simple/t/exit.t Test::Simple test, exit codes lib/Test/Simple/t/extra.t Test::Simple test lib/Test/Simple/t/fail-like.t Test::More test, like() failures diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm index 1378242..2d8eddd 100644 --- a/lib/Test/Builder.pm +++ b/lib/Test/Builder.pm @@ -8,7 +8,7 @@ $^C ||= 0; use strict; use vars qw($VERSION $CLASS); -$VERSION = 0.05; +$VERSION = '0.11'; $CLASS = __PACKAGE__; my $IsVMS = $^O eq 'VMS'; @@ -55,11 +55,13 @@ Test::Builder - Backend for building test libraries =head1 DESCRIPTION -I The interface will change. +I Meaning the underlying code is well +tested, yet the interface is subject to change. 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. +but they're not always flexible enough. Test::Builder provides the a +building block upon which to write your own test libraries I. =head2 Construction @@ -243,8 +245,8 @@ sub ok { $Curr_Test++; $self->diag(<caller; @@ -279,7 +281,7 @@ ERR unless( $test ) { my $msg = $todo ? "Failed (TODO)" : "Failed"; - $self->diag("$msg test ($file at line $line)\n"); + $self->diag(" $msg test ($file at line $line)\n"); } return $test ? 1 : 0; @@ -294,7 +296,7 @@ string version. =item B - $Test->is_num($get, $expected, $name); + $Test->is_num($got, $expected, $name); Like Test::More's is(). Checks if $got == $expected. This is the numeric version. @@ -302,41 +304,112 @@ numeric version. =cut sub is_eq { - my $self = shift; + my($self, $got, $expect, $name) = @_; local $Level = $Level + 1; - return $self->_is('eq', @_); + + 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 = shift; + my($self, $got, $expect, $name) = @_; local $Level = $Level + 1; - return $self->_is('==', @_); + + 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 { - my($self, $type, $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'; + } + } - my $test; - { - local $^W = 0; # so we can compare undef quietly - $test = $type eq 'eq' ? $got eq $expect - : $got == $expect; + $self->diag(sprintf < + + $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 + + $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; - my $ok = $self->ok($test, $name); - unless( $ok ) { - $got = defined $got ? "'$got'" : 'undef'; - $expect = defined $expect ? "'$expect'" : 'undef'; - $self->diag(sprintf <ok($test, $name); + $self->_cmp_diag('!=', $got, $dont_expect) unless $test; + return $test; + } + + return $self->cmp_ok($got, '!=', $dont_expect, $name); } + =item B $Test->like($this, qr/$regex/, $name); @@ -346,36 +419,65 @@ 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 + + $Test->unlike($this, qr/$regex/, $name); + $Test->unlike($this, '/$regex/', $name); + +Like Test::More's unlike(). Checks if $this B 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); +} + +sub _regex_ok { + my($self, $this, $regex, $cmp, $name) = @_; + + local $Level = $Level + 1; my $ok = 0; + my $usable_regex; if( ref $regex eq 'Regexp' ) { - local $^W = 0; - $ok = $self->ok( $this =~ $regex ? 1 : 0, $name ); + $usable_regex = $regex; } # Check if it looks like '/foo/' elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) { - local $^W = 0; - $ok = $self->ok( $this =~ /(?$opts)$re/ ? 1 : 0, $name ); + $usable_regex = "(?$opts)$re"; } else { $ok = $self->ok( 0, $name ); - $self->diag("'$regex' doesn't look much like a regex to me."); + $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'; - $self->diag(sprintf <diag(sprintf < + + $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'; + $self->diag(sprintf < + + $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 $Test->skip; @@ -413,6 +580,41 @@ sub skip { return 1; } + +=item B + + $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 ) { + die "You tried to run tests without a plan! Gotta have a plan.\n"; + } + + $Curr_Test++; + + $Test_Results[$Curr_Test-1] = 1; + + my $out = "not ok"; + $out .= " $Curr_Test" if $self->use_numbers; + $out .= " # TODO $why\n"; + + $Test->_print($out); + + return 1; +} + + =begin _unimplemented =item B @@ -558,7 +760,8 @@ 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. +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. @@ -566,16 +769,18 @@ We encourage using this rather than calling print directly. 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) { - s/^([^#])/# $1/; - s/\n([^#])/\n# $1/g; + 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, ' ', ''); @@ -685,8 +890,14 @@ unless( $^C ) { # 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); @@ -912,24 +1123,24 @@ sub _ending { if( $Curr_Test < $Expected_Tests ) { $self->diag(<<"FAIL"); -# Looks like you planned $Expected_Tests tests but only ran $Curr_Test. +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. +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. +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. +Looks like your test died just after $Curr_Test. FAIL _my_exit( 255 ) && return; @@ -941,7 +1152,7 @@ FAIL _my_exit( 0 ) && return; } else { - $self->diag("# No tests run!\n"); + $self->diag("No tests run!\n"); _my_exit( 255 ) && return; } } @@ -971,7 +1182,7 @@ Copyright 2001 by chromatic Echromatic@wgz.orgE, This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -See L +See F =cut diff --git a/lib/Test/More.pm b/lib/Test/More.pm index 617455f..4b03dff 100644 --- a/lib/Test/More.pm +++ b/lib/Test/More.pm @@ -11,23 +11,25 @@ use Test::Builder; # actually happened. sub _carp { my($file, $line) = (caller(1))[1,2]; - warn @_, sprintf " at $file line $line\n"; + warn @_, " at $file line $line\n"; } require Exporter; use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO); -$VERSION = '0.33'; +$VERSION = '0.41'; @ISA = qw(Exporter); @EXPORT = qw(ok use_ok require_ok - is isnt like is_deeply - skip todo + 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; @@ -38,7 +40,7 @@ sub _export_to_level { my $pkg = shift; my $level = shift; - (undef) = shift; # XXX redundant arg + (undef) = shift; # redundant arg my $callpkg = caller($level); $pkg->export($callpkg, @_); } @@ -64,7 +66,14 @@ Test::More - yet another framework for writing test scripts is ($this, $that, $test_name); isnt($this, $that, $test_name); - like($this, qr/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); @@ -102,13 +111,15 @@ Test::More - yet another framework for writing test scripts =head1 DESCRIPTION -If you're just getting started writing tests, have a look at +B 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. -This module provides a very wide range of testing utilities. Various -ways to say "ok", facilities to skip tests, test future features -and compare complicated data structures. +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 function, it doesn't provide good diagnostic output. =head2 I love it when a plan comes together @@ -320,27 +331,7 @@ sub is ($$;$) { } sub isnt ($$;$) { - my($this, $that, $name) = @_; - - my $test; - { - local $^W = 0; # so isnt(undef, undef) works quietly. - $test = $this ne $that; - } - - my $ok = $Test->ok($test, $name); - - unless( $ok ) { - $that = defined $that ? "'$that'" : 'undef'; - - $Test->diag(sprintf <isnt_eq(@_); } *isn't = \&isnt; @@ -380,6 +371,59 @@ sub like ($$;$) { $Test->like(@_); } + +=item B + + unlike( $this, qr/that/, $test_name ); + +Works exactly as like(), only it checks if $this B match the +given pattern. + +=cut + +sub unlike { + $Test->unlike(@_); +} + + +=item B + + 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 + +Its also useful in those cases where you are comparing numbers and +is()'s use of C will interfere: + + cmp_ok( $big_hairy_number, '==', $another_big_hairy_number ); + +=cut + +sub cmp_ok($$$;$) { + $Test->cmp_ok(@_); +} + + =item B can_ok($module, @methods); @@ -400,15 +444,30 @@ is almost exactly like saying: 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) { my $test = "'$class'->can('$method')"; + local($!, $@); # don't interfere with caller's $@ + # eval sometimes resets $! eval $test || push @nok, $method; } @@ -418,7 +477,7 @@ sub can_ok ($@) { my $ok = $Test->ok( !@nok, $name ); - $Test->diag(map "$class->can('$_') failed\n", @nok); + $Test->diag(map " $class->can('$_') failed\n", @nok); return $ok; } @@ -426,6 +485,7 @@ sub can_ok ($@) { =item B 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 @@ -441,6 +501,10 @@ where you'd otherwise have to write 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'). @@ -459,14 +523,37 @@ sub isa_ok ($$;$) { elsif( !ref $object ) { $diag = "$obj_name isn't a reference"; } - elsif( !$object->isa($class) ) { - $diag = "$obj_name isn't a '$class'"; + 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' its a '$ref'"; + } + } else { + die <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' its a '$ref'"; + } } + + my $ok; if( $diag ) { $ok = $Test->ok( 0, $name ); - $Test->diag("$diag\n"); + $Test->diag(" $diag\n"); } else { $ok = $Test->ok( 1, $name ); @@ -503,6 +590,47 @@ sub fail (;$) { =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. + +=over 4 + +=item B + + 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 with the mnemonic C. + +B 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 @@ -538,6 +666,7 @@ sub use_ok ($;@) { my $pack = caller; + local($@,$!); # eval sometimes interferes with $! eval <diag(<diag(< The following describes an I interface that -is subject to change B! 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 @@ -604,7 +731,8 @@ 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 see L. +For more details on the mechanics of skip and todo tests see +L. 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 @@ -641,10 +769,16 @@ are in the block so the total number of tests comes out right (unless you're using C, in which case you can leave $how_many off if you like). -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. +Its perfectly safe to nest SKIP blocks. + +Tests are skipped when you B expect them to B pass. 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. + +You don't skip tests which are failing because there's a bug in your +program. For that you use TODO. Read on. + =for _Future See L @@ -674,7 +808,7 @@ sub skip { =item B TODO: { - local $TODO = $why; + local $TODO = $why if $condition; ...normal testing code goes here... } @@ -707,6 +841,45 @@ Once a todo test starts succeeding, simply move it outside the block. When the block is empty, delete it. +=item B + + TODO: { + todo_skip $why, $how_many if $condition; + + ...normal testing code... + } + +With todo tests, its 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 with and using C. 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 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; +} + + =back =head2 Comparison functions @@ -729,6 +902,9 @@ 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 Display of scalar refs is not quite 100% =cut @@ -793,6 +969,7 @@ sub _format_stack { $out .= "$vars[0] = $vals[0]\n"; $out .= "$vars[1] = $vals[1]\n"; + $out =~ s/^/ /msg; return $out; } @@ -925,43 +1102,60 @@ sub eq_set { return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] ); } - =back -=head1 NOTES -Test::More is B tested all the way back to perl 5.004. +=head2 Extending and Embedding Test::More -=head1 BUGS and CAVEATS +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. + +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 Making your own ok() +=item B -This will not do what you mean: + my $test_builder = Test::More->builder; - sub my_ok { - ok( @_ ); - } +Returns the Test::Builder object underlying Test::More for you to play +with. + +=cut - my_ok( 2 + 2 == 5, 'Basic addition' ); +sub builder { + return Test::Builder->new; +} -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: +=back - sub my_ok { - ok( $_[0], $_[1] ); - } -The other functions act similarly. +=head1 NOTES + +Test::More is B tested all the way back to perl 5.004. -=item The eq_* family have some caveats. +=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 your end-users will -have to upgrade Test::Harness to the latest one on CPAN. +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. @@ -990,7 +1184,11 @@ L if all this confuses you and you just want to write some tests. You can upgrade to Test::More later (its forward compatible). -L for a similar testing module. +L for more ways to test complex data structures. +And it plays well with Test::More. + +L is the old testing module. Its main benefit is that it has +been distributed with Perl since 5.004_05. L for details on how your test results are interpreted by Perl. @@ -1004,9 +1202,9 @@ L is another approach to embedded testing. =head1 AUTHORS -Michael G Schwern Eschwern@pobox.comE with much inspiration from -Joshua Pritikin's Test module and lots of discussion with Barrie -Slaymaker and the perl-qa gang. +Michael G Schwern Eschwern@pobox.comE 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 @@ -1016,7 +1214,7 @@ Copyright 2001 by Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -See L +See F =cut diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm index 6d0a0a0..339d085 100644 --- a/lib/Test/Simple.pm +++ b/lib/Test/Simple.pm @@ -4,7 +4,7 @@ use 5.004; use strict 'vars'; use vars qw($VERSION); -$VERSION = '0.33'; +$VERSION = '0.41'; use Test::Builder; @@ -227,7 +227,7 @@ Copyright 2001 by Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -See L +See F =cut diff --git a/lib/Test/Simple/Changes b/lib/Test/Simple/Changes index 8aebf59..b13ab46 100644 --- a/lib/Test/Simple/Changes +++ b/lib/Test/Simple/Changes @@ -1,5 +1,34 @@ Revision history for Perl extension Test::Simple +0.41 Mon Dec 17 22:45:20 EST 2001 + * chromatic added diag() + - Internal eval()'s sometimes interfering with $@ and $!. Fixed. + +0.40 Fri Dec 14 15:41:39 EST 2001 + * isa_ok() now accepts unblessed references gracefully + - Nick Clark found a bug with like() and a regex with % in it. + - exit.t was hanging on 5.005_03 VMS perl. Test now skipped. + - can_ok() would pass if no methods were given. Now fails. + - isnt() diagnostic output format changed + * Added some docs about embedding and extending Test::More + * Added Test::More->builder + * Added cmp_ok() + * Added todo_skip() + * Added unlike() + - Piers pointed out that sometimes people override isa(). + isa_ok() now accounts for that. + +0.36 Thu Nov 29 14:07:39 EST 2001 + - Matthias Urlichs found that intermixed prints to STDOUT and test + output came out in the wrong order when piped. + +0.35 Tue Nov 27 19:57:03 EST 2001 + - Little glitch in the test suite. No actual bug. + +0.34 Tue Nov 27 15:43:56 EST 2001 + * Empty string no longer matches undef in is() and isnt(). + * Added isnt_eq and isnt_num to Test::Builder. + 0.33 Mon Oct 22 21:05:47 EDT 2001 * It's now officially safe to redirect STDOUT and STDERR without affecting test output. diff --git a/lib/Test/Simple/t/Builder.t b/lib/Test/Simple/t/Builder.t index 64dfbea..0ef079c 100644 --- a/lib/Test/Simple/t/Builder.t +++ b/lib/Test/Simple/t/Builder.t @@ -1,8 +1,10 @@ #!/usr/bin/perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } use Test::Builder; diff --git a/lib/Test/Simple/t/More.t b/lib/Test/Simple/t/More.t index ee23f6f..bee2fb4 100644 --- a/lib/Test/Simple/t/More.t +++ b/lib/Test/Simple/t/More.t @@ -1,11 +1,19 @@ #!perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } -use Test::More tests => 24; +use Test::More tests => 37; + +# Make sure we don't mess with $@ or $!. Test at bottom. +my $Err = "this should not be touched"; +my $Errno = 42; +$@ = $Err; +$! = $Errno; use_ok('Text::Soundex'); require_ok('Test::More'); @@ -21,12 +29,18 @@ like("fooble", '/^foo/', 'foo is like fooble'); like("FooBle", '/foo/i', 'foo is like FooBle'); like("/usr/local/pr0n/", '/^\/usr\/local/', 'regexes with slashes in like' ); +unlike("fbar", '/^bar/', 'unlike bar'); +unlike("FooBle", '/foo/', 'foo is unlike FooBle'); +unlike("/var/local/pr0n/", '/^\/usr\/local/','regexes with slashes in unlike' ); + can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok pass fail eq_array eq_hash eq_set)); can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip can_ok pass fail eq_array eq_hash eq_set)); isa_ok(bless([], "Foo"), "Foo"); +isa_ok([], 'ARRAY'); +isa_ok(\42, 'SCALAR'); pass('pass() passed'); @@ -92,3 +106,28 @@ ok( eq_hash(\%hash1, \%hash2), 'eq_hash with complicated hashes'); ok( !eq_hash(\%hash1, \%hash2), 'eq_hash with slightly different complicated hashes' ); + +is( Test::Builder->new, Test::More->builder, 'builder()' ); + + +cmp_ok(42, '==', 42, 'cmp_ok =='); +cmp_ok('foo', 'eq', 'foo', ' eq'); +cmp_ok(42.5, '<', 42.6, ' <'); +cmp_ok(0, '||', 1, ' ||'); + + +# Piers pointed out sometimes people override isa(). +{ + package Wibble; + sub isa { + my($self, $class) = @_; + return 1 if $class eq 'Wibblemeister'; + } + sub new { bless {} } +} +isa_ok( Wibble->new, 'Wibblemeister' ); + + +# These two tests must remain at the end. +is( $@, $Err, '$@ untouched' ); +cmp_ok( $!, '==', $Errno, '$! untouched' ); diff --git a/lib/Test/Simple/t/buffer.t b/lib/Test/Simple/t/buffer.t new file mode 100644 index 0000000..7cc64d9 --- /dev/null +++ b/lib/Test/Simple/t/buffer.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +# Ensure that intermixed prints to STDOUT and tests come out in the +# right order (ie. no buffering problems). + +use Test::More tests => 20; +my $T = Test::Builder->new; +$T->no_ending(1); + +for my $num (1..10) { + $tnum = $num * 2; + pass("I'm ok"); + $T->current_test($tnum); + print "ok $tnum - You're ok\n"; +} +#!/usr/bin/perl + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +# Ensure that intermixed prints to STDOUT and tests come out in the +# right order (ie. no buffering problems). + +use Test::More tests => 20; +my $T = Test::Builder->new; +$T->no_ending(1); + +for my $num (1..10) { + $tnum = $num * 2; + pass("I'm ok"); + $T->current_test($tnum); + print "ok $tnum - You're ok\n"; +} diff --git a/lib/Test/Simple/t/diag.t b/lib/Test/Simple/t/diag.t new file mode 100644 index 0000000..7954ed0 --- /dev/null +++ b/lib/Test/Simple/t/diag.t @@ -0,0 +1,114 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use strict; + +use Test::More tests => 5; + +my $Test = Test::More->builder; + +# now make a filehandle where we can send data +my $output; +tie *FAKEOUT, 'FakeOut', \$output; + +# force diagnostic output to a filehandle, glad I added this to Test::Builder :) +my @lines; +{ + local $TODO = 1; + $Test->todo_output(\*FAKEOUT); + + diag("a single line"); + + push @lines, $output; + $output = ''; + + diag("multiple\n", "lines"); + push @lines, split(/\n/, $output); +} + +is( @lines, 3, 'diag() should send messages to its filehandle' ); +like( $lines[0], '/^#\s+/', ' should add comment mark to all lines' ); +is( $lines[0], "# a single line\n", ' should send exact message' ); +is( $output, "# multiple\n# lines\n", ' should append multi messages'); + +{ + local $TODO = 1; + $output = ''; + diag("# foo"); +} +is( $output, "# # foo\n", "diag() adds a # even if there's one already" ); + + +package FakeOut; + +sub TIEHANDLE { + bless( $_[1], $_[0] ); +} + +sub PRINT { + my $self = shift; + $$self .= join('', @_); +} +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use strict; + +use Test::More tests => 5; + +my $Test = Test::More->builder; + +# now make a filehandle where we can send data +my $output; +tie *FAKEOUT, 'FakeOut', \$output; + +# force diagnostic output to a filehandle, glad I added this to Test::Builder :) +my @lines; +{ + local $TODO = 1; + $Test->todo_output(\*FAKEOUT); + + diag("a single line"); + + push @lines, $output; + $output = ''; + + diag("multiple\n", "lines"); + push @lines, split(/\n/, $output); +} + +is( @lines, 3, 'diag() should send messages to its filehandle' ); +like( $lines[0], '/^#\s+/', ' should add comment mark to all lines' ); +is( $lines[0], "# a single line\n", ' should send exact message' ); +is( $output, "# multiple\n# lines\n", ' should append multi messages'); + +{ + local $TODO = 1; + $output = ''; + diag("# foo"); +} +is( $output, "# # foo\n", "diag() adds a # even if there's one already" ); + + +package FakeOut; + +sub TIEHANDLE { + bless( $_[1], $_[0] ); +} + +sub PRINT { + my $self = shift; + $$self .= join('', @_); +} diff --git a/lib/Test/Simple/t/exit.t b/lib/Test/Simple/t/exit.t index 439ccf0..dcc4565 100644 --- a/lib/Test/Simple/t/exit.t +++ b/lib/Test/Simple/t/exit.t @@ -1,14 +1,21 @@ -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - # Can't use Test.pm, that's a 5.005 thing. package My::Test; +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + unless( eval { require File::Spec } ) { print "1..0 # Skip Need File::Spec to run this test\n"; - exit(0); + exit 0; +} + +if( $^O eq 'VMS' && $] <= 5.00503 ) { + print "1..0 # Skip test will hang on older VMS perls\n"; + exit 0; } my $test_num = 1; @@ -47,12 +54,24 @@ my %Tests = ( print "1..".keys(%Tests)."\n"; +chdir 't'; my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests)); while( my($test_name, $exit_codes) = each %Tests ) { my($exit_code) = $exit_codes->[$IsVMS ? 1 : 0]; + my $Perl = $^X; + + if( $^O eq 'VMS' ) { + # VMS can't use its own $^X in a system call until almost 5.8 + $Perl = "MCR $^X" if $] < 5.007003; + + # Quiet noisy 'SYS$ABORT'. 'hushed' only exists in 5.6 and up, + # but it doesn't do any harm on eariler perls. + $Perl .= q{ -"Mvmsish=hushed"}; + } + my $file = File::Spec->catfile($lib, $test_name); - my $wait_stat = system(qq{$^X -"I../lib" -"I../t/lib" $file}); + my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file}); my $actual_exit = $wait_stat >> 8; My::Test::ok( $actual_exit == $exit_code, diff --git a/lib/Test/Simple/t/extra.t b/lib/Test/Simple/t/extra.t index acb23fd..1ed94ad 100644 --- a/lib/Test/Simple/t/extra.t +++ b/lib/Test/Simple/t/extra.t @@ -1,8 +1,10 @@ #!perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } # Can't use Test.pm, that's a 5.005 thing. @@ -28,6 +30,7 @@ package main; require Test::Simple; +chdir 't'; push @INC, '../t/lib/'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); diff --git a/lib/Test/Simple/t/fail-like.t b/lib/Test/Simple/t/fail-like.t index 0821713..1336763 100644 --- a/lib/Test/Simple/t/fail-like.t +++ b/lib/Test/Simple/t/fail-like.t @@ -7,17 +7,20 @@ BEGIN { } } +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} # There was a bug with like() involving a qr// not failing properly. # This tests against that. -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - use strict; -use lib '../t/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); diff --git a/lib/Test/Simple/t/fail-more.t b/lib/Test/Simple/t/fail-more.t index 6c61762..6fd88c8 100644 --- a/lib/Test/Simple/t/fail-more.t +++ b/lib/Test/Simple/t/fail-more.t @@ -1,12 +1,16 @@ #!perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } } use strict; -use lib '../t/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); @@ -36,84 +40,183 @@ sub ok ($;$) { package main; require Test::More; -Test::More->import(tests => 12); +my $Total = 28; +Test::More->import(tests => $Total); # Preserve the line numbers. #line 38 ok( 0, 'failing' ); -is( "foo", "bar", 'foo is bar?'); + +#line 40 +is( "foo", "bar", 'foo is bar?'); +is( undef, '', 'undef is empty string?'); +is( undef, 0, 'undef is 0?'); +is( '', 0, 'empty string is 0?' ); + isnt("foo", "foo", 'foo isnt foo?' ); isn't("foo", "foo",'foo isn\'t foo?' ); like( "foo", '/that/', 'is foo like that' ); +unlike( "foo", '/foo/', 'is foo unlike foo' ); + +# Nick Clark found this was a bug. Fixed in 0.40. +like( "bug", '/(%)/', 'regex with % in it' ); fail('fail()'); +#line 52 can_ok('Mooble::Hooble::Yooble', qw(this that)); +can_ok('Mooble::Hooble::Yooble', ()); + isa_ok(bless([], "Foo"), "Wibble"); isa_ok(42, "Wibble", "My Wibble"); isa_ok(undef, "Wibble", "Another Wibble"); - +isa_ok([], "HASH"); + +#line 68 +cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' ); +cmp_ok( 42.1, '==', 23, , ' ==' ); +cmp_ok( 42, '!=', 42 , ' !=' ); +cmp_ok( 1, '&&', 0 , ' &&' ); +cmp_ok( 42, '==', "foo", ' == with strings' ); +cmp_ok( 42, 'eq', "foo", ' eq with numbers' ); +cmp_ok( undef, 'eq', 'foo', ' eq with undef' ); + +# generate a $!, it changes its value by context. +-e "wibblehibble"; +my $Errno_Number = $!+0; +my $Errno_String = $!.''; +cmp_ok( $!, 'eq', '', ' eq with stringified errno' ); +cmp_ok( $!, '==', -1, ' eq with numerified errno' ); + +#line 84 use_ok('Hooble::mooble::yooble'); require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'); +#line 88 END { My::Test::ok($$out eq <can(...) -not ok 8 - The object isa Wibble -not ok 9 - My Wibble isa Wibble -not ok 10 - Another Wibble isa Wibble -not ok 11 - use Hooble::mooble::yooble; -not ok 12 - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble; +not ok 3 - undef is empty string? +not ok 4 - undef is 0? +not ok 5 - empty string is 0? +not ok 6 - foo isnt foo? +not ok 7 - foo isn't foo? +not ok 8 - is foo like that +not ok 9 - is foo unlike foo +not ok 10 - regex with % in it +not ok 11 - fail() +not ok 12 - Mooble::Hooble::Yooble->can(...) +not ok 13 - Mooble::Hooble::Yooble->can(...) +not ok 14 - The object isa Wibble +not ok 15 - My Wibble isa Wibble +not ok 16 - Another Wibble isa Wibble +not ok 17 - The object isa HASH +not ok 18 - cmp_ok eq +not ok 19 - == +not ok 20 - != +not ok 21 - && +not ok 22 - == with strings +not ok 23 - eq with numbers +not ok 24 - eq with undef +not ok 25 - eq with stringified errno +not ok 26 - eq with numerified errno +not ok 27 - use Hooble::mooble::yooble; +not ok 28 - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble; OUT my $err_re = <can('this') failed # Mooble::Hooble::Yooble->can('that') failed -# Failed test ($0 at line 48) -# The object isn't a 'Wibble' -# Failed test ($0 at line 49) +# Failed test ($0 at line 53) +# can_ok() called with no methods +# Failed test ($0 at line 55) +# The object isn't a 'Wibble' its a 'Foo' +# Failed test ($0 at line 56) # My Wibble isn't a reference -# Failed test ($0 at line 50) +# Failed test ($0 at line 57) # Another Wibble isn't defined +# Failed test ($0 at line 58) +# The object isn't a 'HASH' its a 'ARRAY' +# Failed test ($0 at line 68) +# got: 'foo' +# expected: 'bar' +# Failed test ($0 at line 69) +# got: 42.1 +# expected: 23 +# Failed test ($0 at line 70) +# '42' +# != +# '42' +# Failed test ($0 at line 71) +# '1' +# && +# '0' +# Failed test ($0 at line 72) +# got: 42 +# expected: 0 +# Failed test ($0 at line 73) +# got: '42' +# expected: 'foo' +# Failed test ($0 at line 74) +# got: undef +# expected: 'foo' +# Failed test ($0 at line 80) +# got: '$Errno_String' +# expected: '' +# Failed test ($0 at line 81) +# got: $Errno_Number +# expected: -1 ERR my $filename = quotemeta $0; my $more_err_re = < 1; tie *STDOUT, "Dev::Null" or die $!; diff --git a/lib/Test/Simple/t/import.t b/lib/Test/Simple/t/import.t index bf0b5a9..68a3613 100644 --- a/lib/Test/Simple/t/import.t +++ b/lib/Test/Simple/t/import.t @@ -1,8 +1,11 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } + use Test::More tests => 2, import => [qw(!fail)]; can_ok(__PACKAGE__, qw(ok pass like isa_ok)); diff --git a/lib/Test/Simple/t/is_deeply.t b/lib/Test/Simple/t/is_deeply.t index ea0c150..5291fb8 100644 --- a/lib/Test/Simple/t/is_deeply.t +++ b/lib/Test/Simple/t/is_deeply.t @@ -1,12 +1,16 @@ -#!perl -w +#!/usr/bin/perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } } use strict; -use lib qw(../t/lib); use Test::Builder; require Test::Simple::Catch; diff --git a/lib/Test/Simple/t/missing.t b/lib/Test/Simple/t/missing.t index 9030329..7f45180 100644 --- a/lib/Test/Simple/t/missing.t +++ b/lib/Test/Simple/t/missing.t @@ -1,6 +1,11 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } } # Can't use Test.pm, that's a 5.005 thing. @@ -26,7 +31,6 @@ package main; require Test::Simple; -push @INC, '../t/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); diff --git a/lib/Test/Simple/t/no_ending.t b/lib/Test/Simple/t/no_ending.t index c8bd396..97e968e 100644 --- a/lib/Test/Simple/t/no_ending.t +++ b/lib/Test/Simple/t/no_ending.t @@ -1,10 +1,12 @@ +use Test::Builder; + BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } -use Test::Builder; - BEGIN { my $t = Test::Builder->new; $t->no_ending(1); diff --git a/lib/Test/Simple/t/no_header.t b/lib/Test/Simple/t/no_header.t index b788ef5..93e6bec 100644 --- a/lib/Test/Simple/t/no_header.t +++ b/lib/Test/Simple/t/no_header.t @@ -1,12 +1,10 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } -# STDOUT must be unbuffered else our prints might come out after -# Test::More's. -$| = 1; - use Test::Builder; # STDOUT must be unbuffered else our prints might come out after diff --git a/lib/Test/Simple/t/no_plan.t b/lib/Test/Simple/t/no_plan.t index beca5a6..c0af2d4 100644 --- a/lib/Test/Simple/t/no_plan.t +++ b/lib/Test/Simple/t/no_plan.t @@ -1,6 +1,11 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } } # Can't use Test.pm, that's a 5.005 thing. @@ -26,7 +31,6 @@ package main; require Test::Simple; -push @INC, '../t/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); diff --git a/lib/Test/Simple/t/output.t b/lib/Test/Simple/t/output.t index eca01bc..82dea28 100644 --- a/lib/Test/Simple/t/output.t +++ b/lib/Test/Simple/t/output.t @@ -1,8 +1,10 @@ #!perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } # Can't use Test.pm, that's a 5.005 thing. diff --git a/lib/Test/Simple/t/plan.t b/lib/Test/Simple/t/plan.t index d5d299d..a7b2624 100644 --- a/lib/Test/Simple/t/plan.t +++ b/lib/Test/Simple/t/plan.t @@ -1,6 +1,8 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } use Test::More; diff --git a/lib/Test/Simple/t/plan_is_noplan.t b/lib/Test/Simple/t/plan_is_noplan.t index 6d1ed17..1ab2a0e 100644 --- a/lib/Test/Simple/t/plan_is_noplan.t +++ b/lib/Test/Simple/t/plan_is_noplan.t @@ -1,13 +1,23 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } } # Can't use Test.pm, that's a 5.005 thing. package My::Test; -# This feature requires a fairly new version of Test::Harness BEGIN { + if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) { + print "1..0 # Skipped: Won't work with t/TEST\n"; + exit 0; + } + + # This feature requires a fairly new version of Test::Harness require Test::Harness; if( $Test::Harness::VERSION < 1.20 ) { print "1..0 # Skipped: Need Test::Harness 1.20 or up\n"; @@ -35,7 +45,6 @@ package main; require Test::Simple; -push @INC, '../t/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); diff --git a/lib/Test/Simple/t/plan_no_plan.t b/lib/Test/Simple/t/plan_no_plan.t index 0ccc817..b39b101 100644 --- a/lib/Test/Simple/t/plan_no_plan.t +++ b/lib/Test/Simple/t/plan_no_plan.t @@ -1,56 +1,28 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; +use Test::More; -print "1..2\n"; - -my $test_num = 1; -# Utility testing functions. -sub ok ($;$) { - my($test, $name) = @_; - my $ok = ''; - $ok .= "not " unless $test; - $ok .= "ok $test_num"; - $ok .= " - $name" if defined $name; - $ok .= "\n"; - print $ok; - $test_num++; +BEGIN { + if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) { + plan skip_all => "Won't work with t/TEST"; + } } - -package main; - -require Test::More; -Test::More->import; -my($out, $err); - BEGIN { require Test::Harness; } if( $Test::Harness::VERSION < 1.20 ) { - plan(skip_all => 'Need Test::Harness 1.20 or up'); + plan skip_all => 'Need Test::Harness 1.20 or up'; } else { - push @INC, '../t/lib'; - require Test::Simple::Catch; - ($out, $err) = Test::Simple::Catch::caught(); - plan('no_plan'); + plan 'no_plan'; } pass('Just testing'); ok(1, 'Testing again'); - -END { - My::Test::ok($$out eq < 15; diff --git a/lib/Test/Simple/t/skipall.t b/lib/Test/Simple/t/skipall.t index e41dbc7..6f255e2 100644 --- a/lib/Test/Simple/t/skipall.t +++ b/lib/Test/Simple/t/skipall.t @@ -1,7 +1,12 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} use strict; @@ -27,7 +32,6 @@ sub ok ($;$) { package main; require Test::More; -push @INC, '../t/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); diff --git a/lib/Test/Simple/t/todo.t b/lib/Test/Simple/t/todo.t index 499229c..31ceb5f 100644 --- a/lib/Test/Simple/t/todo.t +++ b/lib/Test/Simple/t/todo.t @@ -1,19 +1,21 @@ #!perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } BEGIN { require Test::Harness; - require Test::More; + use Test::More; if( $Test::Harness::VERSION < 1.23 ) { - Test::More->import(skip_all => 'Need Test::Harness 1.23 or up'); + plan skip_all => 'Need Test::Harness 1.23 or up'; } else { - Test::More->import(tests => 13); + plan tests => 15; } } @@ -53,3 +55,12 @@ TODO: { use_ok('Fooble'); require_ok('Fooble'); } + + +TODO: { + todo_skip "Just testing todo_skip", 2; + + fail("Just testing todo"); + die "todo_skip should prevent this"; + pass("Again"); +} diff --git a/lib/Test/Simple/t/undef.t b/lib/Test/Simple/t/undef.t index 97ae307..5251264 100644 --- a/lib/Test/Simple/t/undef.t +++ b/lib/Test/Simple/t/undef.t @@ -1,15 +1,17 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } use strict; -use Test::More tests => 10; +use Test::More tests => 12; BEGIN { $^W = 1; } my $warnings = ''; -local $SIG{__WARN__} = sub { $warnings = join '', @_ }; +local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; is( undef, undef, 'undef is undef'); is( $warnings, '', ' no warnings' ); @@ -17,6 +19,9 @@ is( $warnings, '', ' no warnings' ); isnt( undef, 'foo', 'undef isnt foo'); is( $warnings, '', ' no warnings' ); +isnt( undef, '', 'undef isnt an empty string' ); +isnt( undef, 0, 'undef isnt zero' ); + like( undef, '/.*/', 'undef is like anything' ); is( $warnings, '', ' no warnings' ); diff --git a/lib/Test/Simple/t/use_ok.t b/lib/Test/Simple/t/use_ok.t index e6e306d..f1d7bed 100644 --- a/lib/Test/Simple/t/use_ok.t +++ b/lib/Test/Simple/t/use_ok.t @@ -1,6 +1,8 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } use Test::More tests => 7; diff --git a/lib/Test/Simple/t/useing.t b/lib/Test/Simple/t/useing.t index 5e5420a..c4ce507 100644 --- a/lib/Test/Simple/t/useing.t +++ b/lib/Test/Simple/t/useing.t @@ -1,6 +1,8 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } } use Test::More tests => 5; diff --git a/lib/Test/Tutorial.pod b/lib/Test/Tutorial.pod index bd5b91d..e07ca32 100644 --- a/lib/Test/Tutorial.pod +++ b/lib/Test/Tutorial.pod @@ -137,8 +137,8 @@ So now you'd see... =head2 Test the manual Simplest way to build up a decent testing suite is to just test what -the manual says it does. [3] Let's pull something out of the -L and test that all it's bits work. +the manual says it does. [3] Let's pull something out of the +L and test that all its bits work. #!/usr/bin/perl -w