diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2001-09-06 01:41:03 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-09-06 01:41:03 +0000 |
commit | d020a79abca8a7921ca8873afa967fc2b6628b7d (patch) | |
tree | c295dd83c8c00711727cddad0ecd7f5ad8b5b1d3 | |
parent | 5c7bc39a40ac58dc19b5fe33db234cae1e26293e (diff) | |
download | perl-d020a79abca8a7921ca8873afa967fc2b6628b7d.tar.gz |
Test-Simple syncup from Schwern.
p4raw-id: //depot/perl@11905
33 files changed, 748 insertions, 339 deletions
@@ -1124,21 +1124,23 @@ lib/Test.pm A simple framework for writing test scripts lib/Test/Harness.pm A test harness lib/Test/Harness.t See if Test::Harness works lib/Test/More.pm More utilities for writing tests -lib/Test/More/Changes Test::More changes -lib/Test/More/t/fail-like.t Test::More test, like() and qr// bug -lib/Test/More/t/fail.t Test::More test, failing tests -lib/Test/More/t/More.t Test::More test, basic operation -lib/Test/More/t/plan_is_noplan.t Test::More test, noplan -lib/Test/More/t/skipall.t Test::More test, skipping all tests lib/Test/Simple.pm Basic utility for writing tests lib/Test/Simple/Changes Test::Simple changes +lib/Test/Simple/t/More.t Test::More test, basic stuff 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 +lib/Test/Simple/t/fail-more.t Test::More test, tests failing lib/Test/Simple/t/fail.t Test::Simple test, test failures lib/Test/Simple/t/missing.t Test::Simple test, missing tests lib/Test/Simple/t/no_plan.t Test::Simple test, forgot the plan lib/Test/Simple/t/plan_is_noplan.t Test::Simple test, no_plan -lib/Test/Simple/t/simple.t for exit.t +lib/Test/Simple/t/simple.t Test::Simple test, basic stuff +lib/Test/Simple/t/skip.t Test::More test, SKIP tests +lib/Test/Simple/t/skipall.t Test::More test, skip all tests +lib/Test/Simple/t/todo.t Test::More test, TODO tests +lib/Test/Simple/t/undef.t Test::More test, undefs don't cause warnings +lib/Test/Simple/t/useing.t Test::More test, compile test lib/Test/t/fail.t See if Test works lib/Test/t/mix.t See if Test works lib/Test/t/onfail.t See if Test works @@ -1146,6 +1148,7 @@ lib/Test/t/qr.t See if Test works lib/Test/t/skip.t See if Test works lib/Test/t/success.t See if Test works lib/Test/t/todo.t See if Test works +lib/Test/Utils.pm Utility module for Test::Simple/More lib/Text/Abbrev.pm An abbreviation table builder lib/Text/Abbrev.t Test Text::Abbrev lib/Text/Balanced.pm Text::Balanced @@ -1957,8 +1960,8 @@ t/lib/st-dump.pl See if Storable works t/lib/strict/refs Tests of "use strict 'refs'" for strict.t t/lib/strict/subs Tests of "use strict 'subs'" for strict.t t/lib/strict/vars Tests of "use strict 'vars'" for strict.t -t/lib/Test/More/Catch.pm Utility module for testing Test::More t/lib/Test/Simple/Catch.pm Utility module for testing Test::Simple +t/lib/Test/Simple/Catch/More.pm Utility module for testing Test::More t/lib/Test/Simple/sample_tests/death.plx for exit.t t/lib/Test/Simple/sample_tests/death_in_eval.plx for exit.t t/lib/Test/Simple/sample_tests/extras.plx for exit.t diff --git a/lib/Test/More.pm b/lib/Test/More.pm index 971e33ff19..aa7032dfb2 100644 --- a/lib/Test/More.pm +++ b/lib/Test/More.pm @@ -1,18 +1,10 @@ package Test::More; -use strict; - - -# Special print function to guard against $\ and -l munging. -sub _print (*@) { - my($fh, @args) = @_; - - local $\; - print $fh @args; -} - -sub print { die "DON'T USE PRINT! Use _print instead" } +use 5.004; +use strict; +use Carp; +use Test::Utils; BEGIN { require Test::Simple; @@ -22,26 +14,39 @@ BEGIN { require Exporter; use vars qw($VERSION @ISA @EXPORT); -$VERSION = '0.07'; +$VERSION = '0.18'; @ISA = qw(Exporter); @EXPORT = qw(ok use_ok require_ok is isnt like skip todo pass fail eq_array eq_hash eq_set + skip + $TODO + plan + can_ok isa_ok ); sub import { my($class, $plan, @args) = @_; - if( $plan eq 'skip_all' ) { - $Test::Simple::Skip_All = 1; - _print *TESTOUT, "1..0\n"; - exit(0); + if( defined $plan ) { + if( $plan eq 'skip_all' ) { + $Test::Simple::Skip_All = 1; + my $out = "1..0"; + $out .= " # Skip @args" if @args; + $out .= "\n"; + + my_print *TESTOUT, $out; + exit(0); + } + else { + Test::Simple->import($plan => @args); + } } else { - Test::Simple->import($plan => @args); + Test::Simple->import; } __PACKAGE__->_export_to_level(1, __PACKAGE__); @@ -68,7 +73,7 @@ Test::More - yet another framework for writing test scripts # 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' ); @@ -80,15 +85,22 @@ Test::More - yet another framework for writing test scripts isnt($this, $that, $test_name); like($this, qr/that/, $test_name); - skip { # UNIMPLEMENTED!!! + 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); @@ -101,11 +113,15 @@ Test::More - yet another framework for writing test scripts # 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 @@ -130,10 +146,11 @@ have no plan. (Try to avoid using this as it weakens your test.) 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 and exit immediately with a zero -(success). L<Test::Harness> for details. +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. =head2 Test names @@ -212,9 +229,9 @@ This is actually Test::Simple's ok() routine. 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" ); @@ -232,7 +249,7 @@ are similar to these: 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?' ); @@ -259,21 +276,28 @@ In these cases, use ok(). 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); + my $test; + { + local $^W = 0; # so is(undef, undef) works quietly. + $test = $this eq $that; + } + my $ok = @_ == 3 ? ok($test, $name) + : ok($test); unless( $ok ) { - _print *TESTERR, <<DIAGNOSTIC; -# got: '$this' -# expected: '$that' + $this = defined $this ? "'$this'" : 'undef'; + $that = defined $that ? "'$that'" : 'undef'; + my_print *TESTERR, sprintf <<DIAGNOSTIC, $this, $that; +# got: %s +# expected: %s DIAGNOSTIC } @@ -284,12 +308,20 @@ DIAGNOSTIC 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 = @_ == 3 ? ok($test, $name) + : ok($test); unless( $ok ) { - _print *TESTERR, <<DIAGNOSTIC; -# it should not be '$that' + $that = defined $that ? "'$that'" : 'undef'; + + my_print *TESTERR, sprintf <<DIAGNOSTIC, $that; +# it should not be %s # but it is. DIAGNOSTIC @@ -318,7 +350,7 @@ is similar to: (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 (ie. C<qr//>) or (for better compatibility with older perls) as a string that looks like a regex (alternative delimiters are currently not supported): @@ -336,11 +368,13 @@ sub like ($$;$) { my $ok = 0; if( ref $regex eq 'Regexp' ) { + local $^W = 0; $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 ) { + local $^W = 0; $ok = @_ == 3 ? ok( $this =~ /(?$opts)$re/ ? 1 : 0, $name ) : ok( $this =~ /(?$opts)$re/ ? 1 : 0 ); } @@ -349,7 +383,7 @@ sub like ($$;$) { my $ok = @_ == 3 ? ok(0, $name ) : ok(0); - _print *TESTERR, <<ERR; + my_print *TESTERR, <<ERR; # '$regex' doesn't look much like a regex to me. Failing the test. ERR @@ -357,8 +391,9 @@ ERR } unless( $ok ) { - _print *TESTERR, <<DIAGNOSTIC; -# '$this' + $this = defined $this ? "'$this'" : 'undef'; + my_print *TESTERR, sprintf <<DIAGNOSTIC, $this; +# %s # doesn't match '$regex' DIAGNOSTIC @@ -367,6 +402,96 @@ DIAGNOSTIC return $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. + +=cut + +sub can_ok ($@) { + my($proto, @methods) = @_; + my $class= ref $proto || $proto; + + my @nok = (); + foreach my $method (@methods) { + my $test = "$class->can('$method')"; + eval $test || push @nok, $method; + } + + my $name; + $name = @methods == 1 ? "$class->can($methods[0])" + : "$class->can(...)"; + + ok( !@nok, $name ); + + my_print *TESTERR, map "# $class->can('$_') failed\n", @nok; + + return !@nok; +} + +=item B<isa_ok> + + isa_ok($object, $class); + +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. + +=cut + +sub isa_ok ($$) { + my($object, $class) = @_; + + my $diag; + my $name = "object->isa('$class')"; + if( !defined $object ) { + $diag = "The object isn't defined"; + } + elsif( !ref $object ) { + $diag = "The object isn't a reference"; + } + elsif( !$object->isa($class) ) { + $diag = "The object isn't a '$class'"; + } + + if( $diag ) { + ok( 0, $name ); + my_print *TESTERR, "# $diag\n"; + return 0; + } + else { + ok( 1, $name ); + return 1; + } +} + + =item B<pass> =item B<fail> @@ -384,13 +509,13 @@ Use these very, very, very sparingly. =cut -sub pass ($) { +sub pass (;$) { my($name) = @_; return @_ == 1 ? ok(1, $name) : ok(1); } -sub fail ($) { +sub fail (;$) { my($name) = @_; return @_ == 1 ? ok(0, $name) : ok(0); @@ -408,33 +533,41 @@ C<use_ok> and C<require_ok>. =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;" ); unless( $ok ) { - _print *TESTERR, <<DIAGNOSTIC; + my_print *TESTERR, <<DIAGNOSTIC; # Tried to use '$module'. # Error: $@ DIAGNOSTIC @@ -444,6 +577,13 @@ 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; @@ -458,7 +598,7 @@ REQUIRE my $ok = ok( !$@, "require $module;" ); unless( $ok ) { - _print *TESTERR, <<DIAGNOSTIC; + my_print *TESTERR, <<DIAGNOSTIC; # Tried to require '$module'. # Error: $@ DIAGNOSTIC @@ -468,70 +608,122 @@ 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; - skip BLOCK $how_many, $why, $if; + ...normal testing code goes here... + } -B<NOTE> Should that be $if or $unless? +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: -This declares a block of tests to skip, why and under what conditions -to skip them. An example is the easiest way to illustrate: + SKIP: { + skip "Pigs don't fly here", 2 unless Pigs->can('fly'); - 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 }; + my $pig = Pigs->new; + $pig->takeoff; + + ok( $pig->altitude > 0, 'Pig is airborne' ); + ok( $pig->airspeed > 0, ' and moving' ); + } -The $if condition is optional, but $why is not. +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>). + +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. + +=for _Future +See L</Why are skip and todo so weird?> =cut +#'# sub skip { - die "skip() is UNIMPLEMENTED!"; + my($why, $how_many) = @_; + unless( $how_many >= 1 ) { + # $how_many can only be avoided when no_plan is in use. + carp "skip() needs to know \$how_many tests are in the block" + if $Test::Simple::Planned_Tests; + $how_many = 1; + } + + for( 1..$how_many ) { + Test::Simple::_skipped($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" ); + } + +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 programatic 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 Comparision functions @@ -572,24 +764,31 @@ sub _deep_check { 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 unintialized 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); + } + else { + $ok = 0; + } } } + return $ok; } @@ -631,7 +830,7 @@ applies to the top level. # 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) = @_; @@ -644,19 +843,49 @@ sub eq_set { =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 + +=item Making your own ok() + +This will not do what you mean: + + sub my_ok { + ok( @_ ); + } + + 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: -todo() and skip() are unimplemented. + sub my_ok { + ok( $_[0], $_[1] ); + } + +The other functions act similiarly. + +=item The eq_* family have some caveats. + +=item Test::Harness upgrades -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. +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 AUTHOR -Michael G Schwern <schwern@pobox.com> with much inspiration from +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. @@ -664,7 +893,7 @@ Slaymaker and the perl-qa gang. =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 unware 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). diff --git a/lib/Test/More/Changes b/lib/Test/More/Changes deleted file mode 100644 index c09ffd91f0..0000000000 --- a/lib/Test/More/Changes +++ /dev/null @@ -1,32 +0,0 @@ -Revision history for Perl extension Test::More. - -0.07 Wed Jun 27 03:06:56 EDT 2001 - - VMS and Win32 fixes. Nothing was actually wrong, but the tests - had little problems. - - like()'s failure report wasn't always accurate - -0.06 Fri Jun 15 14:39:50 EDT 2001 - - Guarding against $/ and -l - - Reformatted the way failed tests are reported to make them stand out - a bit better. - - Fixed tests without names - -0.05 Tue Jun 12 16:16:55 EDT 2001 - * use Test::More no_plan; implemented - -0.04 Thu Jun 7 11:26:18 BST 2001 - - minor bug in eq_set() with complex data structures - Thanks to Tatsuhiko Miyagawa for finding this. - -0.03 Tue Jun 5 19:59:59 BST 2001 - - Fixed export problem in 5.004. - - prototyped the functions properly - * fixed bug with like() involving qr// - -0.02 Thu Apr 5 12:48:48 BST 2001 - - Fixed Makefile.PL to work around MakeMaker bug that 'use's Test::Simple - instead of 'require'ing. - -0.01 Fri Mar 30 07:49:14 GMT 2001 - - First working version - diff --git a/lib/Test/More/t/plan_is_noplan.t b/lib/Test/More/t/plan_is_noplan.t deleted file mode 100644 index b0c031ee3e..0000000000 --- a/lib/Test/More/t/plan_is_noplan.t +++ /dev/null @@ -1,45 +0,0 @@ -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -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++; -} - - -package main; - -require Test::More; - -@INC = ('../lib', 'lib/Test/More'); -require Catch; -my($out, $err) = Catch::caught(); - - -Test::More->import('no_plan'); - -ok(1, 'foo'); - - -END { - My::Test::ok($$out eq <<OUT); -ok 1 - foo -1..1 -OUT - - My::Test::ok($$err eq <<ERR); -ERR - - # Prevent Test::More from exiting with non zero - exit 0; -} diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm index e4727da42b..56706cbbf4 100644 --- a/lib/Test/Simple.pm +++ b/lib/Test/Simple.pm @@ -1,23 +1,19 @@ package Test::Simple; -require 5.004; +use 5.004; -$Test::Simple::VERSION = '0.09'; +use strict 'vars'; +use Test::Utils; + +use vars qw($VERSION); + +$VERSION = '0.18'; my(@Test_Results) = (); my($Num_Tests, $Planned_Tests, $Test_Died) = (0,0,0); my($Have_Plan) = 0; - -# Special print function to guard against $\ and -l munging. -sub _print (*@) { - my($fh, @args) = @_; - - local $\; - print $fh @args; -} - -sub print { die "DON'T USE PRINT! Use _print instead" } +my $IsVMS = $^O eq 'VMS'; # I'd like to have Test::Simple interfere with the program being @@ -56,11 +52,12 @@ sub plan { $Have_Plan = 1; - _print *TESTOUT, "1..$Planned_Tests\n"; + my_print *TESTOUT, "1..$Planned_Tests\n"; + no strict 'refs'; my($caller) = caller; *{$caller.'::ok'} = \&ok; - + } @@ -68,6 +65,7 @@ sub no_plan { $Have_Plan = 1; my($caller) = caller; + no strict 'refs'; *{$caller.'::ok'} = \&ok; } @@ -97,8 +95,12 @@ Test::Simple - Basic utilities for writing tests. =head1 DESCRIPTION +** If you are unfamiliar with testing B<read Test::Tutorial> first! ** + This is an extremely simple, extremely basic module for writing tests -suitable for CPAN modules and other pursuits. +suitable for CPAN modules and other pursuits. If you wish to do more +complicated testing, use the Test::More module (a drop-in replacement +for this one). The basic unit of Perl testing is the ok. For each thing you want to test your program will print out an "ok" or "not ok" to indicate pass @@ -139,7 +141,7 @@ All tests are run in scalar context. So this: ok( @stuff, 'I have some stuff' ); -will do what you mean (fail if stuff is empty). +will do what you mean (fail if stuff is empty) =cut @@ -153,42 +155,74 @@ sub ok ($;$) { $Num_Tests++; - # Make sure the print doesn't get interfered with. - local($\, $,); - - _print *TESTERR, <<ERR if defined $name and $name !~ /\D/; + my_print *TESTERR, <<ERR if defined $name and $name !~ /\D/; You named your test '$name'. You shouldn't use numbers for your test names. Very confusing. ERR + my($pack, $file, $line) = caller; + if( $pack eq 'Test::More' ) { # special case for Test::More's calls + ($pack, $file, $line) = caller(1); + } + + my($is_todo) = ${$pack.'::TODO'} ? 1 : 0; + # We must print this all in one shot or else it will break on VMS my $msg; unless( $test ) { $msg .= "not "; - $Test_Results[$Num_Tests-1] = 0; + $Test_Results[$Num_Tests-1] = $is_todo ? 1 : 0; } else { $Test_Results[$Num_Tests-1] = 1; } $msg .= "ok $Num_Tests"; - $msg .= " - $name" if @_ == 2; + + if( @_ == 2 ) { + $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness. + $msg .= " - $name"; + } + if( $is_todo ) { + my $what_todo = ${$pack.'::TODO'}; + $msg .= " # TODO $what_todo"; + } $msg .= "\n"; - _print *TESTOUT, $msg; + my_print *TESTOUT, $msg; #'# - unless( $test ) { - my($pack, $file, $line) = (caller)[0,1,2]; - if( $pack eq 'Test::More' ) { - ($file, $line) = (caller(1))[1,2]; - } - _print *TESTERR, "# Failed test ($file at line $line)\n"; + unless( $test or $is_todo ) { + my_print *TESTERR, "# Failed test ($file at line $line)\n"; } - return $test; + return $test ? 1 : 0; } + +sub _skipped { + my($why) = shift; + + unless( $Have_Plan ) { + die "You tried to use ok() without a plan! Gotta have a plan.\n". + " use Test::Simple tests => 23; for example.\n"; + } + + $Num_Tests++; + + # XXX Set this to "Skip" instead? + $Test_Results[$Num_Tests-1] = 1; + + # We must print this all in one shot or else it will break on VMS + my $msg; + $msg .= "ok $Num_Tests # skip $why\n"; + + my_print *TESTOUT, $msg; + + return 1; +} + + =back Test::Simple will start by printing number of tests run in the form @@ -267,8 +301,9 @@ doesn't actually exit, that's your job. =cut sub _my_exit { - $? = $_[0]; - return 1; + $? = $_[0]; + + return 1; } @@ -301,7 +336,7 @@ END { if( $Num_Tests ) { # The plan? We have no plan. unless( $Planned_Tests ) { - _print *TESTOUT, "1..$Num_Tests\n"; + my_print *TESTOUT, "1..$Num_Tests\n"; $Planned_Tests = $Num_Tests; } @@ -309,24 +344,24 @@ END { $num_failed += abs($Planned_Tests - @Test_Results); if( $Num_Tests < $Planned_Tests ) { - _print *TESTERR, <<"FAIL"; + my_print *TESTERR, <<"FAIL"; # Looks like you planned $Planned_Tests tests but only ran $Num_Tests. FAIL } elsif( $Num_Tests > $Planned_Tests ) { my $num_extra = $Num_Tests - $Planned_Tests; - _print *TESTERR, <<"FAIL"; + my_print *TESTERR, <<"FAIL"; # Looks like you planned $Planned_Tests tests but ran $num_extra extra. FAIL } elsif ( $num_failed ) { - _print *TESTERR, <<"FAIL"; + my_print *TESTERR, <<"FAIL"; # Looks like you failed $num_failed tests of $Planned_Tests. FAIL } if( $Test_Died ) { - _print *TESTERR, <<"FAIL"; + my_print *TESTERR, <<"FAIL"; # Looks like your test died just after $Num_Tests. FAIL @@ -339,7 +374,7 @@ FAIL _my_exit( 0 ) && return; } else { - _print *TESTERR, "# No tests run!\n"; + my_print *TESTERR, "# No tests run!\n"; _my_exit( 255 ) && return; } } @@ -368,7 +403,7 @@ Here's an example of a simple .t file for the fictional Film module. ok( defined($btaste) and ref $btaste eq 'Film', 'new() works' ); ok( $btaste->Title eq 'Bad Taste', 'Title() get' ); - ok( $btsate->Director eq 'Peter Jackson', 'Director() get' ); + ok( $btaste->Director eq 'Peter Jackson', 'Director() get' ); ok( $btaste->Rating eq 'R', 'Rating() get' ); ok( $btaste->NumExplodingSheep == 1, 'NumExplodingSheep() get' ); @@ -379,7 +414,9 @@ It will produce output like this: ok 2 - Title() get ok 3 - Director() get not ok 4 - Rating() get + # Failed test (t/film.t at line 14) ok 5 - NumExplodingSheep() get + # Looks like you failed 1 tests of 5 Indicating the Film::Rating() method is broken. @@ -391,6 +428,20 @@ code. If this is a problem, you probably have a huge test script. Split it into multiple files. (Otherwise blame the Unix folks for using an unsigned short integer as the exit status). +Because VMS's exit codes are much, much different than the rest of the +universe, and perl does horrible mangling to them that gets in my way, +it works like this on VMS. + + 0 SS$_NORMAL all tests successful + 4 SS$_ABORT something went wrong + +Unfortunately, I can't differentiate any further. + + +=head1 NOTES + +Test::Simple is B<explicitly> tested all the way back to perl 5.004. + =head1 HISTORY @@ -407,7 +458,7 @@ he wasn't in Tony's kitchen). This is it. =head1 AUTHOR Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern -<schwern@pobox.com>, wardrobe by Calvin Klein. +E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein. =head1 SEE ALSO diff --git a/lib/Test/Simple/Changes b/lib/Test/Simple/Changes index ef69c61bda..741c05c18e 100644 --- a/lib/Test/Simple/Changes +++ b/lib/Test/Simple/Changes @@ -1,5 +1,48 @@ Revision history for Perl extension Test::Simple +0.18 Wed Sep 5 20:35:24 EDT 2001 + * ***API CHANGE*** can_ok() only counts as one test + - can_ok() has better diagnostics + - Minor POD fixes from mjd + - adjusting the internal layout to make it easier to put it into + the core + +0.17 Wed Aug 29 20:16:28 EDT 2001 + * Added can_ok() and isa_ok() to Test::More + +0.16 Tue Aug 28 19:52:11 EDT 2001 + * vmsperl foiled my sensisble exit codes. Reverting to a much more + coarse scheme. + +0.15 Tue Aug 28 06:18:35 EDT 2001 *UNRELEASED* + * Now using sensible exit codes on VMS. + +0.14 Wed Aug 22 17:26:28 EDT 2001 + * Added a first cut at Test::Tutorial + +0.13 Tue Aug 14 15:30:10 EDT 2001 + * Added a reason to the skip_all interface + - Fixed a bug to allow 'use Test::More;' to work. + (Thanks to Tatsuhiko Miyagawa again) + - Now always testing backwards compatibility. + +0.12 Tue Aug 14 11:02:39 EDT 2001 + * Fixed some compatibility bugs with older Perls + (Thanks to Tatsuhiko Miyagawa) + +0.11 Sat Aug 11 23:05:19 EDT 2001 + * Will no longer warn about testing undef values + - Escaping # in test names + - Ensuring that ok() returns true or false and not undef + - Minor doc typo in the example + +0.10 Tue Jul 31 15:01:11 EDT 2001 + * Test::More is now distributed in this tarball. + * skip and todo tests work! + * Extended use_ok() so it can import + - A little internal rejiggering + - Added a TODO file + 0.09 Wed Jun 27 02:55:54 EDT 2001 - VMS fixes diff --git a/lib/Test/More/t/More.t b/lib/Test/Simple/t/More.t index 74e64c8506..7dc679649c 100644 --- a/lib/Test/More/t/More.t +++ b/lib/Test/Simple/t/More.t @@ -1,4 +1,4 @@ -use Test::More tests => 18; +use Test::More tests => 22; use_ok('Text::Soundex'); require_ok('Test::More'); @@ -12,6 +12,15 @@ isn't("foo", "bar", 'foo isn\'t bar'); #'# 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' ); + +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"); + pass('pass() passed'); diff --git a/lib/Test/Simple/t/exit.t b/lib/Test/Simple/t/exit.t index dac5c48a1a..27bf1fb3fb 100644 --- a/lib/Test/Simple/t/exit.t +++ b/lib/Test/Simple/t/exit.t @@ -17,29 +17,32 @@ sub ok ($;$) { package main; +my $IsVMS = $^O eq 'VMS'; + +print "# Ahh! I see you're running VMS.\n" if $IsVMS; + my %Tests = ( - 'success.plx' => 0, - 'one_fail.plx' => 1, - 'two_fail.plx' => 2, - 'five_fail.plx' => 5, - 'extras.plx' => 3, - 'too_few.plx' => 4, - 'death.plx' => 255, - 'last_minute_death.plx' => 255, - 'death_in_eval.plx' => 0, - 'require.plx' => 0, + # Everyone Else VMS + 'success.plx' => [0, 0], + 'one_fail.plx' => [1, 4], + 'two_fail.plx' => [2, 4], + 'five_fail.plx' => [5, 4], + 'extras.plx' => [3, 4], + 'too_few.plx' => [4, 4], + 'death.plx' => [255, 4], + 'last_minute_death.plx' => [255, 4], + 'death_in_eval.plx' => [0, 0], + 'require.plx' => [0, 0], ); print "1..".keys(%Tests)."\n"; -chdir 't' if -d 't'; -use File::Spec; -my $lib = File::Spec->catdir('lib', 'Test', 'Simple', 'sample_tests'); -while( my($test_name, $exit_code) = each %Tests ) { - my $file = File::Spec->catfile($lib, $test_name); - my $wait_stat = system(qq{$^X -"I../lib" -"Ilib/Test/Simple" $file}); - My::Test::ok( $wait_stat >> 8 == $exit_code, - "$test_name exited with $exit_code" ); -} +while( my($test_name, $exit_codes) = each %Tests ) { + my($exit_code) = $exit_codes->[$IsVMS ? 1 : 0]; + my $wait_stat = system(qq{$^X t/lib/Test/Simple/sample_tests/$test_name}); + my $actual_exit = $wait_stat >> 8; + My::Test::ok( $actual_exit == $exit_code, + "$test_name exited with $actual_exit (expected $exit_code)"); +} diff --git a/lib/Test/Simple/t/extra.t b/lib/Test/Simple/t/extra.t index d2161e3d2c..0df2c40156 100644 --- a/lib/Test/Simple/t/extra.t +++ b/lib/Test/Simple/t/extra.t @@ -21,9 +21,9 @@ package main; require Test::Simple; -@INC = ('../lib', 'lib/Test/Simple'); -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib/'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 3); diff --git a/lib/Test/More/t/fail-like.t b/lib/Test/Simple/t/fail-like.t index 98564fd05a..dee34e6845 100644 --- a/lib/Test/More/t/fail-like.t +++ b/lib/Test/Simple/t/fail-like.t @@ -33,11 +33,12 @@ sub ok ($;$) { package main; + require Test::More; -@INC = ('../lib', 'lib/Test/More'); -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch::More; +my($out, $err) = Test::Simple::Catch::More::caught(); Test::More->import(tests => 1); diff --git a/lib/Test/More/t/fail.t b/lib/Test/Simple/t/fail-more.t index 9645e2b687..34abfaef92 100644 --- a/lib/Test/More/t/fail.t +++ b/lib/Test/Simple/t/fail-more.t @@ -16,18 +16,23 @@ sub ok ($;$) { $ok .= "\n"; print $ok; $test_num++; + + return $test; } package main; + require Test::More; -@INC = ('../lib', 'lib/Test/More'); -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch::More; +my($out, $err) = Test::Simple::Catch::More::caught(); -Test::More->import(tests => 8); +Test::More->import(tests => 10); +# Preserve the line numbers. +#line 31 ok( 0, 'failing' ); is( "foo", "bar", 'foo is bar?'); isnt("foo", "foo", 'foo isnt foo?' ); @@ -37,20 +42,25 @@ like( "foo", '/that/', 'is foo like that' ); fail('fail()'); +can_ok('Mooble::Hooble::Yooble', qw(this that)); +isa_ok(bless([], "Foo"), "Wibble"); + use_ok('Hooble::mooble::yooble'); require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'); END { My::Test::ok($$out eq <<OUT, 'failing output'); -1..8 +1..10 not ok 1 - failing not ok 2 - foo is bar? not ok 3 - foo isnt foo? not ok 4 - foo isn't foo? not ok 5 - is foo like that not ok 6 - fail() -not ok 7 - use Hooble::mooble::yooble; -not ok 8 - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble; +not ok 7 - Mooble::Hooble::Yooble->can(...) +not ok 8 - object->isa('Wibble') +not ok 9 - use Hooble::mooble::yooble; +not ok 10 - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble; OUT my $err_re = <<ERR; @@ -68,22 +78,30 @@ OUT # 'foo' # doesn't match '/that/' # Failed test ($0 at line 38) +# Failed test ($0 at line 40) +# Mooble::Hooble::Yooble->can('this') failed +# Mooble::Hooble::Yooble->can('that') failed +# Failed test ($0 at line 41) +# The object isn't a 'Wibble' ERR my $filename = quotemeta $0; my $more_err_re = <<ERR; -# Failed test \\($filename at line 40\\) +# Failed test \\($filename at line 43\\) # Tried to use 'Hooble::mooble::yooble'. # Error: Can't locate Hooble.* in \\\@INC .* -# Failed test \\($filename at line 41\\) +# Failed test \\($filename at line 44\\) # Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'. # Error: Can't locate ALL.* in \\\@INC .* -# Looks like you failed 8 tests of 8. +# Looks like you failed 10 tests of 10. ERR - My::Test::ok($$err =~ /^\Q$err_re\E$more_err_re$/, 'failing errors'); + unless( My::Test::ok($$err =~ /^\Q$err_re\E$more_err_re$/, + 'failing errors') ) { + print map "# $_", $$err; + } exit(0); } diff --git a/lib/Test/Simple/t/fail.t b/lib/Test/Simple/t/fail.t index a29158840a..5e77066bce 100644 --- a/lib/Test/Simple/t/fail.t +++ b/lib/Test/Simple/t/fail.t @@ -23,9 +23,9 @@ package main; require Test::Simple; -@INC = ('../lib', 'lib/Test/Simple'); -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); diff --git a/lib/Test/Simple/t/missing.t b/lib/Test/Simple/t/missing.t index 711dbb41cc..fd80c7545e 100644 --- a/lib/Test/Simple/t/missing.t +++ b/lib/Test/Simple/t/missing.t @@ -21,9 +21,9 @@ package main; require Test::Simple; -@INC = ('../lib', 'lib/Test/Simple'); -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); diff --git a/lib/Test/Simple/t/no_plan.t b/lib/Test/Simple/t/no_plan.t index 327f3cab89..f2cc8a894e 100644 --- a/lib/Test/Simple/t/no_plan.t +++ b/lib/Test/Simple/t/no_plan.t @@ -21,9 +21,9 @@ package main; require Test::Simple; -@INC = ('../lib', 'lib/Test/Simple'); -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); eval { Test::Simple->import; diff --git a/lib/Test/Simple/t/plan_is_noplan.t b/lib/Test/Simple/t/plan_is_noplan.t index 0e496055c6..9aeb61dca7 100644 --- a/lib/Test/Simple/t/plan_is_noplan.t +++ b/lib/Test/Simple/t/plan_is_noplan.t @@ -30,9 +30,9 @@ package main; require Test::Simple; -@INC = ('../lib', 'lib/Test/Simple'); -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch::More; +my($out, $err) = Test::Simple::Catch::More::caught(); Test::Simple->import('no_plan'); diff --git a/lib/Test/Simple/t/simple.t b/lib/Test/Simple/t/simple.t deleted file mode 100644 index 7f4f1f42d8..0000000000 --- a/lib/Test/Simple/t/simple.t +++ /dev/null @@ -1,10 +0,0 @@ -use strict; - -BEGIN { $| = 1; $^W = 1; } - -use Test::Simple tests => 3; - -ok(1, 'compile'); - -ok(1); -ok(1, 'foo'); diff --git a/lib/Test/Simple/t/skip.t b/lib/Test/Simple/t/skip.t new file mode 100644 index 0000000000..2b469495ec --- /dev/null +++ b/lib/Test/Simple/t/skip.t @@ -0,0 +1,43 @@ +use Test::More tests => 9; + +# If we skip with the same name, Test::Harness will report it back and +# we won't get lots of false bug reports. +my $Why = "Just testing the skip interface."; + +SKIP: { + skip $Why, 2 + unless Pigs->can('fly'); + + my $pig = Pigs->new; + $pig->takeoff; + + ok( $pig->altitude > 0, 'Pig is airborne' ); + ok( $pig->airspeed > 0, ' and moving' ); +} + + +SKIP: { + skip "We're not skipping", 2 if 0; + + pass("Inside skip block"); + pass("Another inside"); +} + + +SKIP: { + skip "Again, not skipping", 2 if 0; + + my($pack, $file, $line) = caller; + is( $pack || '', '', 'calling package not interfered with' ); + is( $file || '', '', ' or file' ); + is( $line || '', '', ' or line' ); +} + + +SKIP: { + skip $Why, 2 if 1; + + die "A horrible death"; + fail("Deliberate failure"); + fail("And again"); +} diff --git a/lib/Test/More/t/skipall.t b/lib/Test/Simple/t/skipall.t index ff7607dd43..43ea12a63b 100644 --- a/lib/Test/More/t/skipall.t +++ b/lib/Test/Simple/t/skipall.t @@ -22,9 +22,9 @@ sub ok ($;$) { package main; require Test::More; -@INC = ('../lib', 'lib/Test/More'); -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch::More; +my($out, $err) = Test::Simple::Catch::More::caught(); Test::More->import('skip_all'); diff --git a/lib/Test/Simple/t/todo.t b/lib/Test/Simple/t/todo.t new file mode 100644 index 0000000000..399aa475be --- /dev/null +++ b/lib/Test/Simple/t/todo.t @@ -0,0 +1,32 @@ +BEGIN { + require Test::Harness; + require Test::More; + + if( $Test::Harness::VERSION < 1.23 ) { + Test::More->import(skip_all => 'Need the new Test::Harness'); + } + else { + Test::More->import(tests => 5); + } +} + +$Why = 'Just testing the todo interface.'; + +TODO: { + local $TODO = $Why; + + fail("Expected failure"); + fail("Another expected failure"); +} + + +pass("This is not todo"); + + +TODO: { + local $TODO = $Why; + + fail("Yet another failure"); +} + +pass("This is still not todo"); diff --git a/lib/Test/Simple/t/undef.t b/lib/Test/Simple/t/undef.t new file mode 100644 index 0000000000..67507a5c6f --- /dev/null +++ b/lib/Test/Simple/t/undef.t @@ -0,0 +1,33 @@ +use strict; +use Test::More tests => 10; + +BEGIN { $^W = 1; } + +my $warnings = ''; +local $SIG{__WARN__} = sub { $warnings = join '', @_ }; + +is( undef, undef, 'undef is undef'); +is( $warnings, '', ' no warnings' ); + +isnt( undef, 'foo', 'undef isnt foo'); +is( $warnings, '', ' no warnings' ); + +like( undef, '/.*/', 'undef is like anything' ); +is( $warnings, '', ' no warnings' ); + +eq_array( [undef, undef], [undef, 23] ); +is( $warnings, '', 'eq_array() no warnings' ); + +eq_hash ( { foo => undef, bar => undef }, + { foo => undef, bar => 23 } ); +is( $warnings, '', 'eq_hash() no warnings' ); + +eq_set ( [undef, undef, 12], [29, undef, undef] ); +is( $warnings, '', 'eq_set() no warnings' ); + + +eq_hash ( { foo => undef, bar => { baz => undef, moo => 23 } }, + { foo => undef, bar => { baz => undef, moo => 23 } } ); +is( $warnings, '', 'eq_hash() no warnings' ); + + diff --git a/lib/Test/Simple/t/useing.t b/lib/Test/Simple/t/useing.t new file mode 100644 index 0000000000..93ad4619c8 --- /dev/null +++ b/lib/Test/Simple/t/useing.t @@ -0,0 +1,5 @@ +use Test::More tests => 2; + +use_ok("Test::More"); + +use_ok("Test::Simple"); diff --git a/lib/Test/Utils.pm b/lib/Test/Utils.pm new file mode 100644 index 0000000000..17908ebb1a --- /dev/null +++ b/lib/Test/Utils.pm @@ -0,0 +1,26 @@ +package Test::Utils; + +use 5.004; + +use strict; +require Exporter; +use vars qw($VERSION @EXPORT @EXPORT_TAGS @ISA); + +$VERSION = '0.02'; + +@ISA = qw(Exporter); +@EXPORT = qw( my_print print ); + + + +# Special print function to guard against $\ and -l munging. +sub my_print (*@) { + my($fh, @args) = @_; + + local $\; + print $fh @args; +} + +sub print { die "DON'T USE PRINT! Use _print instead" } + +1; diff --git a/t/lib/Test/Simple/Catch.pm b/t/lib/Test/Simple/Catch.pm index 2f8c887d49..3460a64dcb 100644 --- a/t/lib/Test/Simple/Catch.pm +++ b/t/lib/Test/Simple/Catch.pm @@ -1,8 +1,8 @@ # For testing Test::Simple; -package Catch; +package Test::Simple::Catch; -my $out = tie *Test::Simple::TESTOUT, 'Catch'; -my $err = tie *Test::Simple::TESTERR, 'Catch'; +my $out = tie *Test::Simple::TESTOUT, __PACKAGE__; +my $err = tie *Test::Simple::TESTERR, __PACKAGE__; # We have to use them to shut up a "used only once" warning. () = (*Test::Simple::TESTOUT, *Test::Simple::TESTERR); diff --git a/t/lib/Test/More/Catch.pm b/t/lib/Test/Simple/Catch/More.pm index aed94682d4..f4dee3f3ad 100644 --- a/t/lib/Test/More/Catch.pm +++ b/t/lib/Test/Simple/Catch/More.pm @@ -1,10 +1,10 @@ # For testing Test::More; -package Catch; +package Test::Simple::Catch::More; -my $out = tie *Test::Simple::TESTOUT, 'Catch'; -tie *Test::More::TESTOUT, 'Catch', $out; -my $err = tie *Test::More::TESTERR, 'Catch'; -tie *Test::Simple::TESTERR, 'Catch', $err; +my $out = tie *Test::Simple::TESTOUT, __PACKAGE__; +tie *Test::More::TESTOUT, __PACKAGE__, $out; +my $err = tie *Test::More::TESTERR, __PACKAGE__; +tie *Test::Simple::TESTERR, __PACKAGE__, $err; # We have to use them to shut up a "used only once" warning. () = (*Test::More::TESTOUT, *Test::More::TESTERR); diff --git a/t/lib/Test/Simple/sample_tests/death.plx b/t/lib/Test/Simple/sample_tests/death.plx index 8796eb2451..ef4ba8c188 100644 --- a/t/lib/Test/Simple/sample_tests/death.plx +++ b/t/lib/Test/Simple/sample_tests/death.plx @@ -1,8 +1,8 @@ require Test::Simple; -push @INC, 't', '.'; -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); close STDERR; diff --git a/t/lib/Test/Simple/sample_tests/death_in_eval.plx b/t/lib/Test/Simple/sample_tests/death_in_eval.plx index 969dbb009a..269bffa802 100644 --- a/t/lib/Test/Simple/sample_tests/death_in_eval.plx +++ b/t/lib/Test/Simple/sample_tests/death_in_eval.plx @@ -1,9 +1,9 @@ require Test::Simple; use Carp; -push @INC, 't', '.'; -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); diff --git a/t/lib/Test/Simple/sample_tests/extras.plx b/t/lib/Test/Simple/sample_tests/extras.plx index ed2d6abbbf..c9c89520aa 100644 --- a/t/lib/Test/Simple/sample_tests/extras.plx +++ b/t/lib/Test/Simple/sample_tests/extras.plx @@ -1,8 +1,8 @@ require Test::Simple; -push @INC, 't', '.'; -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); diff --git a/t/lib/Test/Simple/sample_tests/five_fail.plx b/t/lib/Test/Simple/sample_tests/five_fail.plx index c95e4100d5..d33b84519b 100644 --- a/t/lib/Test/Simple/sample_tests/five_fail.plx +++ b/t/lib/Test/Simple/sample_tests/five_fail.plx @@ -1,8 +1,8 @@ require Test::Simple; -push @INC, 't', '.'; -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); diff --git a/t/lib/Test/Simple/sample_tests/last_minute_death.plx b/t/lib/Test/Simple/sample_tests/last_minute_death.plx index e1df5b1970..ef86a63c51 100644 --- a/t/lib/Test/Simple/sample_tests/last_minute_death.plx +++ b/t/lib/Test/Simple/sample_tests/last_minute_death.plx @@ -1,8 +1,8 @@ require Test::Simple; -push @INC, 't', '.'; -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); close STDERR; diff --git a/t/lib/Test/Simple/sample_tests/one_fail.plx b/t/lib/Test/Simple/sample_tests/one_fail.plx index 1762d65df0..99c720250d 100644 --- a/t/lib/Test/Simple/sample_tests/one_fail.plx +++ b/t/lib/Test/Simple/sample_tests/one_fail.plx @@ -1,8 +1,8 @@ require Test::Simple; -push @INC, 't', '.'; -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); diff --git a/t/lib/Test/Simple/sample_tests/success.plx b/t/lib/Test/Simple/sample_tests/success.plx index eb40a2d7d0..585d6c3d79 100644 --- a/t/lib/Test/Simple/sample_tests/success.plx +++ b/t/lib/Test/Simple/sample_tests/success.plx @@ -1,8 +1,8 @@ require Test::Simple; -push @INC, 't', '.'; -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); diff --git a/t/lib/Test/Simple/sample_tests/too_few.plx b/t/lib/Test/Simple/sample_tests/too_few.plx index 36acac94f6..95af8e903b 100644 --- a/t/lib/Test/Simple/sample_tests/too_few.plx +++ b/t/lib/Test/Simple/sample_tests/too_few.plx @@ -1,8 +1,8 @@ require Test::Simple; -push @INC, 't', '.'; -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); diff --git a/t/lib/Test/Simple/sample_tests/two_fail.plx b/t/lib/Test/Simple/sample_tests/two_fail.plx index 5ddb912dec..e3d92296af 100644 --- a/t/lib/Test/Simple/sample_tests/two_fail.plx +++ b/t/lib/Test/Simple/sample_tests/two_fail.plx @@ -1,8 +1,8 @@ require Test::Simple; -push @INC, 't', '.'; -require Catch; -my($out, $err) = Catch::caught(); +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); |