From: Rafael Garcia-Suarez Date: Mon, 6 Nov 2006 10:59:16 +0000 (+0000) Subject: Upgrade to Test::Simple 0.64_03 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=004caa160f94253de79aa75f9b412f94823dcb96;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Test::Simple 0.64_03 p4raw-id: //depot/perl@29211 --- diff --git a/MANIFEST b/MANIFEST index b5a4017..502d98d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2427,6 +2427,7 @@ lib/Test/Simple/t/bad_plan.t Test::Builder plan() test lib/Test/Simple/t/bail_out.t Test::Builder BAIL_OUT test lib/Test/Simple/t/buffer.t Test::Builder buffering test lib/Test/Simple/t/Builder.t Test::Builder tests +lib/Test/Simple/t/carp.t Test::Builder test lib/Test/Simple/t/circular_data.t Test::Simple test lib/Test/Simple/t/create.t Test::Simple test lib/Test/Simple/t/curr_test.t Test::Builder->curr_test tests diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm index d0b379a..7eb13ad 100644 --- a/lib/Test/Builder.pm +++ b/lib/Test/Builder.pm @@ -8,7 +8,7 @@ $^C ||= 0; use strict; use vars qw($VERSION); -$VERSION = '0.33_02'; +$VERSION = '0.33_03'; $VERSION = eval $VERSION; # make the alpha version come out as a number # Make Test::Builder thread-safe for ithreads. @@ -247,6 +247,8 @@ sub plan { return unless $cmd; + local $Level = $Level + 1; + if( $self->{Have_Plan} ) { $self->croak("You tried to plan twice"); } @@ -1019,8 +1021,6 @@ or this if false Most useful when you can't depend on the test output order, such as when threads or forking is involved. -Test::Harness will accept either, but avoid mixing the two styles. - Defaults to on. =cut @@ -1339,7 +1339,7 @@ point where the original test function was called (C<$tb->caller>). sub _message_at_caller { my $self = shift; - local $Level = $Level + 2; + local $Level = $Level + 1; my($pack, $file, $line) = $self->caller; return join("", @_) . " at $file line $line.\n"; } @@ -1358,7 +1358,7 @@ sub _plan_check { my $self = shift; unless( $self->{Have_Plan} ) { - local $Level = $Level + 1; + local $Level = $Level + 2; $self->croak("You tried to run a test without a plan"); } } diff --git a/lib/Test/Builder/Module.pm b/lib/Test/Builder/Module.pm index 146e434..2232714 100644 --- a/lib/Test/Builder/Module.pm +++ b/lib/Test/Builder/Module.pm @@ -5,7 +5,7 @@ use Test::Builder; require Exporter; @ISA = qw(Exporter); -$VERSION = '0.03_02'; +$VERSION = '0.03_03'; use strict; diff --git a/lib/Test/Builder/Tester.pm b/lib/Test/Builder/Tester.pm index ab32588..e6a7aaa 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.04_02"; +$VERSION = "1.04_03"; use Test::Builder; use Symbol; diff --git a/lib/Test/More.pm b/lib/Test/More.pm index 4759e68..cce7082 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.64_02'; +$VERSION = '0.64_03'; $VERSION = eval $VERSION; # make the alpha version come out as a number use Test::Builder::Module; @@ -51,20 +51,20 @@ Test::More - yet another framework for writing test scripts require_ok( 'Some::Module' ); # Various ways to say "ok" - ok($this eq $that, $test_name); + ok($got eq $expected, $test_name); - is ($this, $that, $test_name); - isnt($this, $that, $test_name); + is ($got, $exptected, $test_name); + isnt($got, $expected, $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); + like ($got, qr/expected/, $test_name); + unlike($got, qr/expected/, $test_name); - cmp_ok($this, '==', $that, $test_name); + cmp_ok($got, '==', $expected, $test_name); - is_deeply($complex_structure1, $complex_structure2, $test_name); + is_deeply($got_complex_structure, $expected_complex_structure, $test_name); SKIP: { skip $why, $how_many unless $have_some_feature; @@ -226,9 +226,9 @@ respectively. =item B - ok($this eq $that, $test_name); + ok($got eq $expected, $test_name); -This simply evaluates any expression (C<$this eq $that> is just a +This simply evaluates any expression (C<$got eq $expected> is just a simple example) and uses that to determine if the test succeeded or failed. A true expression passes, a false one fails. Very simple. @@ -252,7 +252,7 @@ Should an ok() fail, it will produce some diagnostics: # Failed test 'sufficient mucus' # in foo.t at line 42. -This is actually Test::Simple's ok() routine. +This is the same as Test::Simple's ok() routine. =cut @@ -267,8 +267,8 @@ sub ok ($;$) { =item B - is ( $this, $that, $test_name ); - isnt( $this, $that, $test_name ); + is ( $got, $expected, $test_name ); + isnt( $got, $expected, $test_name ); Similar to ok(), is() and isnt() compare their two arguments with C and C respectively and use the result of that to @@ -340,17 +340,17 @@ sub isnt ($$;$) { =item B - like( $this, qr/that/, $test_name ); + like( $got, qr/expected/, $test_name ); -Similar to ok(), like() matches $this against the regex C. +Similar to ok(), like() matches $got against the regex C. So this: - like($this, qr/that/, 'this is like that'); + like($got, qr/expected/, 'this is like that'); is similar to: - ok( $this =~ /that/, 'this is like that'); + ok( $got =~ /expected/, 'this is like that'); (Mnemonic "This is like that".) @@ -359,9 +359,9 @@ regex reference (i.e. C) or (for better compatibility with older perls) as a string that looks like a regex (alternative delimiters are currently not supported): - like( $this, '/that/', 'this is like that' ); + like( $got, '/expected/', 'this is like that' ); -Regex options may be placed on the end (C<'/that/i'>). +Regex options may be placed on the end (C<'/expected/i'>). Its advantages over ok() are similar to that of is() and isnt(). Better diagnostics on failure. @@ -377,9 +377,9 @@ sub like ($$;$) { =item B - unlike( $this, qr/that/, $test_name ); + unlike( $got, qr/expected/, $test_name ); -Works exactly as like(), only it checks if $this B match the +Works exactly as like(), only it checks if $got B match the given pattern. =cut @@ -393,23 +393,23 @@ sub unlike ($$;$) { =item B - cmp_ok( $this, $op, $that, $test_name ); + cmp_ok( $got, $op, $expected, $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( $got eq $expected ); + cmp_ok( $got, 'eq', $expected, 'this eq that' ); - # ok( $this == $that ); - cmp_ok( $this, '==', $that, 'this == that' ); + # ok( $got == $expected ); + cmp_ok( $got, '==', $expected, 'this == that' ); - # ok( $this && $that ); - cmp_ok( $this, '&&', $that, 'this && that' ); + # ok( $got && $expected ); + cmp_ok( $got, '&&', $expected, 'this && that' ); ...etc... -Its advantage over ok() is when the test fails you'll know what $this -and $that were: +Its advantage over ok() is when the test fails you'll know what $got +and $expected were: not ok 1 # Failed test in foo.t at line 12. @@ -760,9 +760,9 @@ B I'm not quite sure what will happen with filehandles. =item B - is_deeply( $this, $that, $test_name ); + is_deeply( $got, $expected, $test_name ); -Similar to is(), except that if $this and $that are references, it +Similar to is(), except that if $got and $expected are 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. @@ -798,21 +798,21 @@ WARNING return $tb->ok(0); } - my($this, $that, $name) = @_; + my($got, $expected, $name) = @_; - $tb->_unoverload_str(\$that, \$this); + $tb->_unoverload_str(\$expected, \$got); my $ok; - if( !ref $this and !ref $that ) { # neither is a reference - $ok = $tb->is_eq($this, $that, $name); + if( !ref $got and !ref $expected ) { # neither is a reference + $ok = $tb->is_eq($got, $expected, $name); } - elsif( !ref $this xor !ref $that ) { # one's a reference, one isn't + elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't $ok = $tb->ok(0, $name); - $tb->diag( _format_stack({ vals => [ $this, $that ] }) ); + $tb->diag( _format_stack({ vals => [ $got, $expected ] }) ); } else { # both references local @Data_Stack = (); - if( _deep_check($this, $that) ) { + if( _deep_check($got, $expected) ) { $ok = $tb->ok(1, $name); } else { @@ -1149,11 +1149,11 @@ arbitrary data structures. These functions are usually used inside an ok(). - ok( eq_array(\@this, \@that) ); + ok( eq_array(\@got, \@expected) ); C can do that better and with diagnostics. - is_deeply( \@this, \@that ); + is_deeply( \@got, \@expected ); They may be deprecated in future versions. @@ -1161,7 +1161,7 @@ They may be deprecated in future versions. =item B - my $is_eq = eq_array(\@this, \@that); + my $is_eq = eq_array(\@got, \@expected); Checks if two arrays are equivalent. This is a deep check, so multi-level structures are handled correctly. @@ -1292,7 +1292,7 @@ WHOA =item B - my $is_eq = eq_hash(\%this, \%that); + my $is_eq = eq_hash(\%got, \%expected); Determines if the two hashes contain the same keys and values. This is a deep check. @@ -1332,17 +1332,17 @@ sub _eq_hash { =item B - my $is_eq = eq_set(\@this, \@that); + my $is_eq = eq_set(\@got, \@expected); Similar to eq_array(), except the order of the elements is B important. This is a deep check, but the irrelevancy of order only applies to the top level. - ok( eq_set(\@this, \@that) ); + ok( eq_set(\@got, \@expected) ); Is better written: - is_deeply( [sort @this], [sort @that] ); + is_deeply( [sort @got], [sort @expected] ); B By historical accident, this is not a true set comparison. While the order of elements does not matter, duplicate elements do. @@ -1537,9 +1537,9 @@ See F to report and view bugs. =head1 COPYRIGHT -Copyright 2001, 2002, 2004 by Michael G Schwern Eschwern@pobox.comE. +Copyright 2001-2002, 2004-2006 by Michael G Schwern Eschwern@pobox.comE. -This program is free software; you can redistribute it and/or +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm index 2edea47..47cb2bc 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.64_02'; +$VERSION = '0.64_03'; $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 433720d..65234a5 100644 --- a/lib/Test/Simple/Changes +++ b/lib/Test/Simple/Changes @@ -1,3 +1,14 @@ +0.64_03 Sun Nov 5 13:09:55 EST 2006 + - Tests will no longer warn when run against an alpha version of + Test::Harness [rt.cpan.org #20501] + - Now testing our POD and POD coverage. + - Added a LICENSE field. + - Removed warning from the docs about mixing numbered and unnumbered + tests. There's nothing wrong with that. [rt.cpan.org 21358] + - Change doc examples to talk about $got and $expected rather than + $this and $that to correspond better to the diagnostic output + [rt.cpan.org 2655] + 0.64_02 Sat Sep 9 12:16:56 EDT 2006 - Last release broke Perls earlier than 5.8. @@ -8,6 +19,7 @@ users. Not a real bug. [rt.cpan.org 21310] - _print_diag() accidentally leaked into the public documentation. It is a private method. + * Added Test::Builder->carp() and croak() * Made most of the error messages report in the caller's context. [rt.cpan.org #20639] * Made the failure diagnostic message file and line reporting portion diff --git a/lib/Test/Simple/t/00test_harness_check.t b/lib/Test/Simple/t/00test_harness_check.t index 262d53b..3ff4a13 100644 --- a/lib/Test/Simple/t/00test_harness_check.t +++ b/lib/Test/Simple/t/00test_harness_check.t @@ -8,7 +8,7 @@ plan tests => 1; my $TH_Version = 2.03; require Test::Harness; -unless( cmp_ok( $Test::Harness::VERSION, '>=', $TH_Version, "T::H version" ) ) { +unless( cmp_ok( eval $Test::Harness::VERSION, '>=', $TH_Version, "T::H version" ) ) { diag < 3; +use Test::Builder; + +my $tb = Test::Builder->create; +sub foo { $tb->croak("foo") } +sub bar { $tb->carp("bar") } + +eval { foo() }; +is $@, sprintf "foo at %s line %s.\n", $0, __LINE__ - 1; + +eval { $tb->croak("this") }; +is $@, sprintf "this at %s line %s.\n", $0, __LINE__ - 1; + +{ + my $warning = ''; + local $SIG{__WARN__} = sub { + $warning .= join '', @_; + }; + + bar(); + is $warning, sprintf "bar at %s line %s.\n", $0, __LINE__ - 1; +} diff --git a/lib/Test/Simple/t/tbt_01basic.t b/lib/Test/Simple/t/tbt_01basic.t index 77d1081..769a1c4 100644 --- a/lib/Test/Simple/t/tbt_01basic.t +++ b/lib/Test/Simple/t/tbt_01basic.t @@ -1,12 +1,5 @@ #!/usr/bin/perl -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - use Test::Builder::Tester tests => 9; use Test::More; @@ -29,7 +22,7 @@ ok(2,"two"); test_test("multiple tests"); test_out("not ok 1 - should fail"); -test_err("# Failed test ($0 at line 35)"); +test_err("# Failed test ($0 at line 28)"); test_err("# got: 'foo'"); test_err("# expected: 'bar'"); is("foo","bar","should fail"); @@ -53,7 +46,7 @@ test_test("testing failing on the same line with the same name"); test_out("not ok 1 - name # TODO Something"); -test_err("# Failed (TODO) test ($0 at line 59)"); +test_err("# Failed (TODO) test ($0 at line 52)"); TODO: { local $TODO = "Something"; fail("name"); diff --git a/lib/Test/Simple/t/tbt_02fhrestore.t b/lib/Test/Simple/t/tbt_02fhrestore.t index a9cf36e..e373571 100644 --- a/lib/Test/Simple/t/tbt_02fhrestore.t +++ b/lib/Test/Simple/t/tbt_02fhrestore.t @@ -1,12 +1,5 @@ #!/usr/bin/perl -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - use Test::Builder::Tester tests => 4; use Test::More; use Symbol; diff --git a/lib/Test/Simple/t/tbt_03die.t b/lib/Test/Simple/t/tbt_03die.t index ad40ac4..b9dba80 100644 --- a/lib/Test/Simple/t/tbt_03die.t +++ b/lib/Test/Simple/t/tbt_03die.t @@ -1,12 +1,5 @@ #!/usr/bin/perl -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - use Test::Builder::Tester tests => 1; use Test::More; diff --git a/lib/Test/Simple/t/tbt_04line_num.t b/lib/Test/Simple/t/tbt_04line_num.t index 0155cda..9e8365a 100644 --- a/lib/Test/Simple/t/tbt_04line_num.t +++ b/lib/Test/Simple/t/tbt_04line_num.t @@ -1,15 +1,8 @@ #!/usr/bin/perl -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - use Test::More tests => 3; use Test::Builder::Tester; -is(line_num(),13,"normal line num"); -is(line_num(-1),13,"line number minus one"); -is(line_num(+2),17,"line number plus two"); +is(line_num(),6,"normal line num"); +is(line_num(-1),6,"line number minus one"); +is(line_num(+2),10,"line number plus two"); diff --git a/lib/Test/Simple/t/tbt_05faildiag.t b/lib/Test/Simple/t/tbt_05faildiag.t index 0ae875a..59ad721 100644 --- a/lib/Test/Simple/t/tbt_05faildiag.t +++ b/lib/Test/Simple/t/tbt_05faildiag.t @@ -1,12 +1,5 @@ #!/usr/bin/perl -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - use Test::Builder::Tester tests => 5; use Test::More; diff --git a/lib/Test/Simple/t/tbt_06errormess.t b/lib/Test/Simple/t/tbt_06errormess.t index 159038e..d8d8a0f 100644 --- a/lib/Test/Simple/t/tbt_06errormess.t +++ b/lib/Test/Simple/t/tbt_06errormess.t @@ -1,12 +1,5 @@ #!/usr/bin/perl -w -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - use Test::More tests => 8; use Symbol; use Test::Builder; diff --git a/lib/Test/Simple/t/tbt_07args.t b/lib/Test/Simple/t/tbt_07args.t index 37f1050..1b9393b 100644 --- a/lib/Test/Simple/t/tbt_07args.t +++ b/lib/Test/Simple/t/tbt_07args.t @@ -1,12 +1,5 @@ #!/usr/bin/perl -w -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - use Test::More tests => 18; use Symbol; use Test::Builder;