From: Steve Peters Date: Sun, 16 Jul 2006 14:54:58 +0000 (+0000) Subject: Upgrade to Test-Simple-0.64 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1be77ff7d37fc4eb628469fa5911923c9a996995;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Test-Simple-0.64 p4raw-id: //depot/perl@28586 --- diff --git a/lib/Test/Builder/Tester.pm b/lib/Test/Builder/Tester.pm index 92ca096..7eab5a5 100644 --- a/lib/Test/Builder/Tester.pm +++ b/lib/Test/Builder/Tester.pm @@ -2,7 +2,7 @@ package Test::Builder::Tester; use strict; use vars qw(@EXPORT $VERSION @ISA); -$VERSION = "1.03"; +$VERSION = "1.04"; use Test::Builder; use Symbol; @@ -18,21 +18,11 @@ Test::Builder use Test::Builder::Tester tests => 1; use Test::More; - test_fail(+1, "foo"); + test_out("not ok 1 - foo"); + test_fail(+1); fail("foo"); test_test("fail works"); - test_pass("baz"); - ok(1, "baz"); - test_test("pass works"); - - test_fail(+3, "is foo bar?"); - test_err("# got: 'foo'", - "# expected: 'bar'"); - is("foo", "bar", "is foo bar?"); - test_test("diagnostic checking works"); - - =head1 DESCRIPTION A module that helps you test testing modules that are built with @@ -40,8 +30,8 @@ B. The testing system is designed to be used by performing a three step process for each test you wish to test. This process starts with using -Test::Builder::Tester functions to declare what the testsuite you -are testing will output with B. +C and C in advance to declare what the testsuite you +are testing will output with B to stdout and stderr. You then can run the test(s) from your test suite that call B. At this point the output of B is @@ -68,7 +58,7 @@ my $t = Test::Builder->new; use Exporter; @ISA = qw(Exporter); -@EXPORT = qw(test_out test_err test_fail test_diag test_test line_num test_pass); +@EXPORT = qw(test_out test_err test_fail test_diag test_test line_num); # _export_to_level and import stolen directly from Test::More. I am # the king of cargo cult programming ;-) @@ -112,8 +102,8 @@ my $output_handle = gensym; my $error_handle = gensym; # and tie them to this package -my $out = tie *$output_handle, "Test::Tester::Tie", "STDOUT"; -my $err = tie *$error_handle, "Test::Tester::Tie", "STDERR"; +my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; +my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; #### # exported functions @@ -166,43 +156,55 @@ sub _start_testing =head2 Functions -These are the functions exported by default. +These are the six methods that are exported as default. =over 4 -=item test_pass +=item test_out - test_pass(); - test_pass($description); +=item test_err -Because the standard success message that B produces -whenever a test passes will be common in your test error -output, rather than forcing you to call C with the string -all the time like so +Procedures for predeclaring the output that your test suite is +expected to produce until C is called. These procedures +automatically assume that each line terminates with "\n". So - test_out("ok 1 - some test name here"); + test_out("ok 1","ok 2"); -C exists as a convenience function that you can call instead. It -takes one optional argument, the test description from the test you expect to -pass. The following is equivalent to the above C call. +is the same as + + test_out("ok 1\nok 2"); + +which is even the same as - test_pass("some test name here"); + test_out("ok 1"); + test_out("ok 2"); + +Once C or C (or C or C) have +been called once all further output from B will be +captured by B. This means that your will not +be able perform further tests to the normal output in the normal way +until you call C (well, unless you manually meddle with the +output filehandles) =cut -sub test_pass(;$) +sub test_out(@) { - _start_testing() unless $testing++; - my $mess = "ok $testing"; - $mess .= ' - ' . shift if @_; - $out->expect( $mess, @_ ); + # do we need to do any setup? + _start_testing() unless $testing; + + $out->expect(@_) } +sub test_err(@) +{ + # do we need to do any setup? + _start_testing() unless $testing; -=item test_fail + $err->expect(@_) +} - test_fail($line_num_offset); - test_fail($line_num_offset, $description); +=item test_fail Because the standard failure message that B produces whenever a test fails will be a common occurrence in your test error @@ -217,81 +219,30 @@ instead. It takes one argument, the offset from the current line that the line that causes the fail is on. test_fail(+1); - ok(0); -It optionally takes the $description of the test. +This means that the example in the synopsis could be rewritten +more simply as: - test_fail(+1, "kaboom"); - fail("kaboom"); + test_out("not ok 1 - foo"); + test_fail(+1); + fail("foo"); + test_test("fail works"); =cut sub test_fail { # do we need to do any setup? - _start_testing() unless $testing++; + _start_testing() unless $testing; # work out what line we should be on my ($package, $filename, $line) = caller; $line = $line + (shift() || 0); # prevent warnings - my $mess = "not ok $testing"; - $mess .= ' - ' . shift if @_; - $out->expect( $mess ); - # expect that on stderr $err->expect("# Failed test ($0 at line $line)"); } - -=item test_out - - test_out(@output); - -=item test_err - - test_err(@diagnostic_output); - -Procedures for predeclaring the output that your test suite is -expected to produce until C is called. These procedures -automatically assume that each line terminates with "\n". So - - test_out("foo","bar"); - -is the same as - - test_out("foo\nbar"); - -which is even the same as - - test_out("foo"); - test_out("bar"); - -Once C or C (or C, C, or -C) have been called once all further output from B -will be captured by B. This means that your will not be -able perform further tests to the normal output in the normal way until you -call C. - -=cut - -sub test_out(@) -{ - # do we need to do any setup? - _start_testing() unless $testing; - - $out->expect(@_) -} - -sub test_err(@) -{ - # do we need to do any setup? - _start_testing() unless $testing; - - $err->expect(@_) -} - - =item test_diag As most of the remaining expected output to the error stream will be @@ -407,6 +358,7 @@ sub test_test && ($args{skip_err} || $err->check), $mess)) { + # print out the diagnostic information about why this # test failed local $_; @@ -533,7 +485,7 @@ L, L, L. #################################################################### # Helper class that is used to remember expected and received data -package Test::Tester::Tie; +package Test::Builder::Tester::Tie; ## # add line(s) to be expected @@ -591,7 +543,7 @@ sub complaint my $self = shift; my $type = $self->type; my $got = $self->got; - my $wanted = join '', @{$self->wanted}; + my $wanted = join "\n", @{$self->wanted}; # are we running in colour mode? if (Test::Builder::Tester::color) diff --git a/lib/Test/More.pm b/lib/Test/More.pm index be7e9fc..465ccd3 100644 --- a/lib/Test/More.pm +++ b/lib/Test/More.pm @@ -16,7 +16,7 @@ sub _carp { use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO); -$VERSION = '0.63'; +$VERSION = '0.64'; $VERSION = eval $VERSION; # make the alpha version come out as a number use Test::Builder::Module; @@ -487,7 +487,7 @@ sub can_ok ($@) { my $name; $name = @methods == 1 ? "$class->can('$methods[0]')" : "$class->can(...)"; - + my $ok = $tb->ok( !@nok, $name ); $tb->diag(map " $class->can('$_') failed\n", @nok); @@ -1001,6 +1001,11 @@ sub skip { $how_many = 1; } + if( defined $how_many and $how_many =~ /\D/ ) { + _carp "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?"; + $how_many = 1; + } + for( 1..$how_many ) { $tb->skip($why); } diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm index d9d1617..ae912d2 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 @ISA @EXPORT); -$VERSION = '0.63'; +$VERSION = '0.64'; $VERSION = eval $VERSION; # make the alpha version come out as a number use Test::Builder::Module; diff --git a/lib/Test/Simple/Changes b/lib/Test/Simple/Changes index 83c82d5..94491eb 100644 --- a/lib/Test/Simple/Changes +++ b/lib/Test/Simple/Changes @@ -1,3 +1,9 @@ +0.64 Sun Jul 16 02:47:29 PDT 2006 + * 0.63's change to test_fail() broke backwards compatibility. They + have been removed for the time being. test_pass() went with it. + This is [rt.cpan.org 11317] and [rt.cpan.org 11319]. + - skip() will now warn if you get the args backwards. + 0.63 Sun Jul 9 02:36:36 PDT 2006 * Fixed can_ok() to gracefully handle no class name. Submitted by "Pete Krawczyk" diff --git a/lib/Test/Simple/t/skip.t b/lib/Test/Simple/t/skip.t index 526c5ac..f2ea9fb 100644 --- a/lib/Test/Simple/t/skip.t +++ b/lib/Test/Simple/t/skip.t @@ -7,7 +7,7 @@ BEGIN { } } -use Test::More tests => 15; +use Test::More tests => 17; # If we skip with the same name, Test::Harness will report it back and # we won't get lots of false bug reports. @@ -84,3 +84,15 @@ SKIP: { pass("This is supposed to run, too"); } +{ + my $warning = ''; + local $SIG{__WARN__} = sub { $warning .= join "", @_ }; + + SKIP: { + skip 1, "This is backwards" if 1; + + pass "This does not run"; + } + + like $warning, qr/^skip\(\) was passed a non-numeric number of tests/; +} diff --git a/lib/Test/Simple/t/tbt_01basic.t b/lib/Test/Simple/t/tbt_01basic.t index b79f2e5..77d1081 100644 --- a/lib/Test/Simple/t/tbt_01basic.t +++ b/lib/Test/Simple/t/tbt_01basic.t @@ -7,7 +7,7 @@ BEGIN { } } -use Test::Builder::Tester tests => 12; +use Test::Builder::Tester tests => 9; use Test::More; ok(1,"This is a basic test"); @@ -36,37 +36,27 @@ is("foo","bar","should fail"); test_test("testing failing"); +test_out("not ok 1"); +test_out("not ok 2"); test_fail(+2); test_fail(+1); fail(); fail(); test_test("testing failing on the same line with no name"); -test_fail(+2, 'name'); -test_fail(+1, 'name_two'); -fail("name"); fail("name_two"); +test_out("not ok 1 - name"); +test_out("not ok 2 - name"); +test_fail(+2); +test_fail(+1); +fail("name"); fail("name"); test_test("testing failing on the same line with the same name"); test_out("not ok 1 - name # TODO Something"); -my $line = __LINE__ + 4; -test_err("# Failed (TODO) test ($0 at line $line)"); +test_err("# Failed (TODO) test ($0 at line 59)"); TODO: { local $TODO = "Something"; fail("name"); } test_test("testing failing with todo"); -test_pass(); -pass(); -test_test("testing passing with test_pass()"); - -test_pass("some description"); -pass("some description"); -test_test("testing passing with test_pass() and description"); - -test_pass("one test"); -test_pass("... and another"); -ok(1, "one test"); -ok(1, "... and another"); -test_test("testing pass_test() and multiple tests"); diff --git a/lib/Test/Simple/t/tbt_05faildiag.t b/lib/Test/Simple/t/tbt_05faildiag.t index d643e3f..0ae875a 100644 --- a/lib/Test/Simple/t/tbt_05faildiag.t +++ b/lib/Test/Simple/t/tbt_05faildiag.t @@ -12,23 +12,26 @@ use Test::More; # test_fail -test_fail(+1, 'one'); +test_out("not ok 1 - one"); +test_fail(+1); ok(0,"one"); -test_fail(+2, 'two'); +test_out("not ok 2 - two"); +test_fail(+2); ok(0,"two"); test_test("test fail"); -test_fail(+1, 'one'); +test_fail(+2); +test_out("not ok 1 - one"); ok(0,"one"); test_test("test_fail first"); # test_diag use Test::Builder; -my $test = Test::Builder->new(); +my $test = new Test::Builder; test_diag("this is a test string","so is this"); $test->diag("this is a test string\n", "so is this\n"); @@ -44,3 +47,5 @@ test_diag("so is this"); $test->diag("this is a test string\n"); $test->diag("so is this\n"); test_test("test diag multiple"); + + diff --git a/lib/Test/Simple/t/tbt_06errormess.t b/lib/Test/Simple/t/tbt_06errormess.t index e7625ea..159038e 100644 --- a/lib/Test/Simple/t/tbt_06errormess.t +++ b/lib/Test/Simple/t/tbt_06errormess.t @@ -25,8 +25,8 @@ my $output_handle = gensym; my $error_handle = gensym; # and tie them to this package -my $out = tie *$output_handle, "Test::Tester::Tie", "STDOUT"; -my $err = tie *$error_handle, "Test::Tester::Tie", "STDERR"; +my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; +my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; # ooooh, use the test suite my $t = Test::Builder->new; diff --git a/lib/Test/Simple/t/tbt_07args.t b/lib/Test/Simple/t/tbt_07args.t index 8e80234..37f1050 100644 --- a/lib/Test/Simple/t/tbt_07args.t +++ b/lib/Test/Simple/t/tbt_07args.t @@ -25,8 +25,8 @@ my $output_handle = gensym; my $error_handle = gensym; # and tie them to this package -my $out = tie *$output_handle, "Test::Tester::Tie", "STDOUT"; -my $err = tie *$error_handle, "Test::Tester::Tie", "STDERR"; +my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; +my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; # ooooh, use the test suite my $t = Test::Builder->new;