diff options
Diffstat (limited to 'lib/Test/Simple/t')
25 files changed, 676 insertions, 131 deletions
diff --git a/lib/Test/Simple/t/00signature.t b/lib/Test/Simple/t/00signature.t new file mode 100644 index 0000000000..b36f68e2e2 --- /dev/null +++ b/lib/Test/Simple/t/00signature.t @@ -0,0 +1,22 @@ +#!/usr/bin/perl +# $File: //member/autrijus/Module-Signature/t/0-signature.t $ $Author: autrijus $ +# $Revision: #5 $ $Change: 7212 $ $DateTime: 2003/07/28 14:21:21 $ + +use strict; +use Test::More tests => 1; + +SKIP: { + if (!eval { require Module::Signature; 1 }) { + skip("Next time around, consider install Module::Signature, ". + "so you can verify the integrity of this distribution.", 1); + } + elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) { + skip("Cannot connect to the keyserver", 1); + } + else { + ok(Module::Signature::verify() == Module::Signature::SIGNATURE_OK() + => "Valid signature" ); + } +} + +__END__ diff --git a/lib/Test/Simple/t/00test_harness_check.t b/lib/Test/Simple/t/00test_harness_check.t new file mode 100644 index 0000000000..7a290f4877 --- /dev/null +++ b/lib/Test/Simple/t/00test_harness_check.t @@ -0,0 +1,24 @@ +#!/usr/bin/perl -w + +# A test to make sure the new Test::Harness was installed properly. + +use Test::More; +plan tests => 1; + +require Test::Harness; +unless( cmp_ok( $Test::Harness::VERSION, '>', 1.20, "T::H version" ) ) { + diag <<INSTRUCTIONS; + +Test::Simple/More/Builder has features which depend on a version of +Test::Harness greater than 1.20. You have $Test::Harness::VERSION. +Please install a new version from CPAN. + +If you've already tried to upgrade Test::Harness and still get this +message, the new version may be "shadowed" by the old. Check the +output of Test::Harness's "make install" for "## Differing version" +messages. You can delete the old version by running +"make install UNINST=1". + +INSTRUCTIONS +} + diff --git a/lib/Test/Simple/t/More.t b/lib/Test/Simple/t/More.t index df8c5fea17..71f3fd0dfe 100644 --- a/lib/Test/Simple/t/More.t +++ b/lib/Test/Simple/t/More.t @@ -7,7 +7,7 @@ BEGIN { } } -use Test::More tests => 41; +use Test::More tests => 42; # Make sure we don't mess with $@ or $!. Test at bottom. my $Err = "this should not be touched"; @@ -33,6 +33,9 @@ unlike("fbar", '/^bar/', 'unlike bar'); unlike("FooBle", '/foo/', 'foo is unlike FooBle'); unlike("/var/local/pr0n/", '/^\/usr\/local/','regexes with slashes in unlike' ); +my @foo = qw(foo bar baz); +unlike(@foo, '/foo/'); + 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 diff --git a/lib/Test/Simple/t/diag.t b/lib/Test/Simple/t/diag.t index 453984b3c6..3afdc17678 100644 --- a/lib/Test/Simple/t/diag.t +++ b/lib/Test/Simple/t/diag.t @@ -7,6 +7,18 @@ BEGIN { } } + +# Turn on threads here, if available, since this test tends to find +# lots of threading bugs. +use Config; +BEGIN { + if( $] >= 5.008 && $Config{useithreads} ) { + require threads; + 'threads'->import; + } +} + + use strict; use Test::More tests => 7; diff --git a/lib/Test/Simple/t/eq_set.t b/lib/Test/Simple/t/eq_set.t new file mode 100644 index 0000000000..4785507a61 --- /dev/null +++ b/lib/Test/Simple/t/eq_set.t @@ -0,0 +1,21 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} +chdir 't'; + +use strict; +use Test::More; + +plan tests => 2; + +# RT 3747 +ok( eq_set([1, 2, [3]], [[3], 1, 2]) ); +ok( eq_set([1,2,[3]], [1,[3],2]) ); diff --git a/lib/Test/Simple/t/extra.t b/lib/Test/Simple/t/extra.t index 1ed94adb77..4dceb2cf63 100644 --- a/lib/Test/Simple/t/extra.t +++ b/lib/Test/Simple/t/extra.t @@ -34,6 +34,7 @@ chdir 't'; push @INC, '../t/lib/'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; Test::Simple->import(tests => 3); diff --git a/lib/Test/Simple/t/extra_one.t b/lib/Test/Simple/t/extra_one.t new file mode 100644 index 0000000000..f8dacc614a --- /dev/null +++ b/lib/Test/Simple/t/extra_one.t @@ -0,0 +1,59 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +# 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::Simple; +Test::Simple->import(tests => 1); +ok(1); +ok(1); +ok(1); + +END { + My::Test::ok($$out eq <<OUT); +1..1 +ok 1 +ok 2 +ok 3 +OUT + + My::Test::ok($$err eq <<ERR); +# Looks like you planned 1 test but ran 2 extra. +ERR + + # Prevent Test::Simple from existing with non-zero + exit 0; +} diff --git a/lib/Test/Simple/t/fail-like.t b/lib/Test/Simple/t/fail-like.t index 13367633cd..799762f6a6 100644 --- a/lib/Test/Simple/t/fail-like.t +++ b/lib/Test/Simple/t/fail-like.t @@ -2,7 +2,7 @@ # of high enough version. BEGIN { if( $] < 5.005 ) { - print "1..0\n"; + print "1..0 # Skipped Test requires qr//\n"; exit(0); } } @@ -24,6 +24,7 @@ use strict; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; # Can't use Test.pm, that's a 5.005 thing. @@ -63,7 +64,7 @@ OUT # Failed test \\(.*\\) # 'foo' # doesn't match '\\(\\?-xism:that\\)' -# Looks like you failed 1 tests of 1\\. +# Looks like you failed 1 test of 1\\. ERR diff --git a/lib/Test/Simple/t/fail-more.t b/lib/Test/Simple/t/fail-more.t index 29f8eb25ac..ab18b5b3d2 100644 --- a/lib/Test/Simple/t/fail-more.t +++ b/lib/Test/Simple/t/fail-more.t @@ -14,12 +14,13 @@ use strict; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; # Can't use Test.pm, that's a 5.005 thing. package My::Test; -print "1..2\n"; +print "1..12\n"; my $test_num = 1; # Utility testing functions. @@ -37,98 +38,43 @@ sub ok ($;$) { } +sub main::err ($) { + my($expect) = @_; + my $got = $err->read; + + my $ok = ok( $got eq $expect ); + + unless( $ok ) { + print STDERR "$got\n"; + print STDERR "$expect\n"; + } + + return $ok; +} + + package main; require Test::More; -my $Total = 28; +my $Total = 29; Test::More->import(tests => $Total); +my $tb = Test::More->builder; +$tb->use_numbers(0); + # Preserve the line numbers. #line 38 ok( 0, 'failing' ); +err( <<ERR ); +# Failed test ($0 at line 38) +ERR #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 <<OUT, 'failing output'); -1..$Total -not ok 1 - failing -not ok 2 - foo is bar? -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 = <<ERR; -# Failed test ($0 at line 38) +err( <<ERR ); # Failed test ($0 at line 40) # got: 'foo' # expected: 'bar' @@ -141,6 +87,13 @@ OUT # Failed test ($0 at line 43) # got: '' # expected: '0' +ERR + +#line 45 +isnt("foo", "foo", 'foo isnt foo?' ); +isn't("foo", "foo",'foo isn\'t foo?' ); +isnt(undef, undef, 'undef isnt undef?'); +err( <<ERR ); # Failed test ($0 at line 45) # 'foo' # ne @@ -149,21 +102,54 @@ OUT # 'foo' # ne # 'foo' +# Failed test ($0 at line 47) +# undef +# ne +# undef +ERR + +#line 48 +like( "foo", '/that/', 'is foo like that' ); +unlike( "foo", '/foo/', 'is foo unlike foo' ); +err( <<ERR ); # Failed test ($0 at line 48) # 'foo' # doesn't match '/that/' # Failed test ($0 at line 49) # 'foo' # matches '/foo/' -# Failed test ($0 at line 52) +ERR + +# Nick Clark found this was a bug. Fixed in 0.40. +like( "bug", '/(%)/', 'regex with % in it' ); +err( <<ERR ); +# Failed test ($0 at line 60) # 'bug' # doesn't match '/(%)/' -# Failed test ($0 at line 54) +ERR + +fail('fail()'); +err( <<ERR ); +# Failed test ($0 at line 67) +ERR + +#line 52 +can_ok('Mooble::Hooble::Yooble', qw(this that)); +can_ok('Mooble::Hooble::Yooble', ()); +err( <<ERR ); # Failed test ($0 at line 52) # Mooble::Hooble::Yooble->can('this') failed # Mooble::Hooble::Yooble->can('that') failed # Failed test ($0 at line 53) # can_ok() called with no methods +ERR + +#line 55 +isa_ok(bless([], "Foo"), "Wibble"); +isa_ok(42, "Wibble", "My Wibble"); +isa_ok(undef, "Wibble", "Another Wibble"); +isa_ok([], "HASH"); +err( <<ERR ); # Failed test ($0 at line 55) # The object isn't a 'Wibble' it's a 'Foo' # Failed test ($0 at line 56) @@ -172,6 +158,17 @@ OUT # Another Wibble isn't defined # Failed test ($0 at line 58) # The object isn't a 'HASH' it's a 'ARRAY' +ERR + +#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' ); +err( <<ERR ); # Failed test ($0 at line 68) # got: 'foo' # expected: 'bar' @@ -195,6 +192,16 @@ OUT # Failed test ($0 at line 74) # got: undef # expected: 'foo' +ERR + +# generate a $!, it changes its value by context. +-e "wibblehibble"; +my $Errno_Number = $!+0; +my $Errno_String = $!.''; +#line 80 +cmp_ok( $!, 'eq', '', ' eq with stringified errno' ); +cmp_ok( $!, '==', -1, ' eq with numerified errno' ); +err( <<ERR ); # Failed test ($0 at line 80) # got: '$Errno_String' # expected: '' @@ -203,18 +210,58 @@ OUT # expected: -1 ERR +#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 <<OUT, 'failing output'); +1..$Total +not ok - failing +not ok - foo is bar? +not ok - undef is empty string? +not ok - undef is 0? +not ok - empty string is 0? +not ok - foo isnt foo? +not ok - foo isn't foo? +not ok - undef isnt undef? +not ok - is foo like that +not ok - is foo unlike foo +not ok - regex with % in it +not ok - fail() +not ok - Mooble::Hooble::Yooble->can(...) +not ok - Mooble::Hooble::Yooble->can(...) +not ok - The object isa Wibble +not ok - My Wibble isa Wibble +not ok - Another Wibble isa Wibble +not ok - The object isa HASH +not ok - cmp_ok eq +not ok - == +not ok - != +not ok - && +not ok - == with strings +not ok - eq with numbers +not ok - eq with undef +not ok - eq with stringified errno +not ok - eq with numerified errno +not ok - use Hooble::mooble::yooble; +not ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble; +OUT + my $filename = quotemeta $0; my $more_err_re = <<ERR; # Failed test \\($filename at line 84\\) # Tried to use 'Hooble::mooble::yooble'. # Error: Can't locate Hooble.* in \\\@INC .* +# BEGIN failed--compilation aborted at $filename line 84. # Failed test \\($filename at line 85\\) # Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'. # Error: Can't locate ALL.* in \\\@INC .* # Looks like you failed $Total tests of $Total. ERR - unless( My::Test::ok($$err =~ /^\Q$err_re\E$more_err_re$/, + unless( My::Test::ok($$err =~ /^$more_err_re$/, 'failing errors') ) { print $$err; } diff --git a/lib/Test/Simple/t/fail.t b/lib/Test/Simple/t/fail.t index a041ab0eb9..30a107b6cb 100644 --- a/lib/Test/Simple/t/fail.t +++ b/lib/Test/Simple/t/fail.t @@ -14,6 +14,7 @@ use strict; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; # Can't use Test.pm, that's a 5.005 thing. diff --git a/lib/Test/Simple/t/fail_one.t b/lib/Test/Simple/t/fail_one.t new file mode 100644 index 0000000000..d9ce4b85c0 --- /dev/null +++ b/lib/Test/Simple/t/fail_one.t @@ -0,0 +1,62 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 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++; + + return $test ? 1 : 0; +} + + +package main; + +require Test::Simple; +Test::Simple->import(tests => 1); + +#line 45 +ok(0); + +END { + My::Test::ok($$out eq <<OUT); +1..1 +not ok 1 +OUT + + My::Test::ok($$err eq <<"ERR") || print $$err; +# Failed test ($0 at line 45) +# Looks like you failed 1 test of 1. +ERR + + # Prevent Test::Simple from existing with non-zero + exit 0; +} diff --git a/lib/Test/Simple/t/harness_active.t b/lib/Test/Simple/t/harness_active.t new file mode 100644 index 0000000000..be4bb85087 --- /dev/null +++ b/lib/Test/Simple/t/harness_active.t @@ -0,0 +1,99 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +use Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + + +# Can't use Test.pm, that's a 5.005 thing. +package My::Test; + +print "1..4\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++; + + return $test; +} + + +sub main::err ($) { + my($expect) = @_; + my $got = $err->read; + + my $ok = ok( $got eq $expect ); + + unless( $ok ) { + print STDERR "got\n$got\n"; + print STDERR "expected\n$expect\n"; + } + + return $ok; +} + + +package main; + +require Test::More; +Test::More->import(tests => 4); +Test::More->builder->no_ending(1); + +{ + local $ENV{HARNESS_ACTIVE} = 0; + +#line 62 + fail( "this fails" ); + err( <<ERR ); +# Failed test ($0 at line 62) +ERR + +#line 72 + is( 1, 0 ); + err( <<ERR ); +# Failed test ($0 at line 72) +# got: '1' +# expected: '0' +ERR +} + +{ + local $ENV{HARNESS_ACTIVE} = 1; + +#line 71 + fail( "this fails" ); + err( <<ERR ); + +# Failed test ($0 at line 71) +ERR + + +#line 84 + is( 1, 0 ); + err( <<ERR ); + +# Failed test ($0 at line 84) +# got: '1' +# expected: '0' +ERR + +} diff --git a/lib/Test/Simple/t/has_plan2.t b/lib/Test/Simple/t/has_plan2.t index 2b9ac499da..b988737d08 100644 --- a/lib/Test/Simple/t/has_plan2.t +++ b/lib/Test/Simple/t/has_plan2.t @@ -19,8 +19,12 @@ BEGIN { require Test::Harness; } -if( $Test::Harness::VERSION < 1.20 ) { - plan skip_all => 'Need Test::Harness 1.20 or up'; +# This feature requires a fairly new version of Test::Harness +if( $Test::Harness::VERSION < 2.03 ) { + plan tests => 1; + diag "Need Test::Harness 2.03 or up. You have $Test::Harness::VERSION."; + fail 'Need Test::Harness 2.03 or up'; + exit; } use strict; diff --git a/lib/Test/Simple/t/is_deeply.t b/lib/Test/Simple/t/is_deeply.t index 5291fb82c2..867b1c3509 100644 --- a/lib/Test/Simple/t/is_deeply.t +++ b/lib/Test/Simple/t/is_deeply.t @@ -17,11 +17,13 @@ require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Builder->new->no_header(1); Test::Builder->new->no_ending(1); +local $ENV{HARNESS_ACTIVE} = 0; + # Can't use Test.pm, that's a 5.005 thing. package main; -print "1..22\n"; +print "1..25\n"; my $test_num = 1; # Utility testing functions. @@ -48,8 +50,9 @@ sub is ($$;$) { sub like ($$;$) { my($this, $regex, $name) = @_; - - my $test = $$this =~ /$regex/; + + $regex = qr/$regex/ unless ref $regex; + my $test = $$this =~ $regex; my $ok = ''; $ok .= "not " unless $test; @@ -140,7 +143,7 @@ is( $err, <<ERR, ' right diagnostic' ); ERR #line 131 -is_deeply({ foo => undef }, {}, 'hashes of undefs', 'hashes of undefs' ); +is_deeply({ foo => undef }, {}, 'hashes of undefs' ); is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' ); is( $err, <<ERR, ' right diagnostic' ); # Failed test ($0 at line 131) @@ -213,3 +216,21 @@ is( $err, <<ERR, ' right diagnostic' ); # \$got->{that}{foo} = Does not exist # \$expected->{that}{foo} = '42' ERR + + +#line 221 +my @tests = ([], + [qw(42)], + [qw(42 23), qw(42 23)] + ); + +foreach my $test (@tests) { + my $num_args = @$test; + + my $warning; + local $SIG{__WARN__} = sub { $warning .= join '', @_; }; + is_deeply(@$test); + + like \$warning, + qr/^is_deeply\(\) takes two or three args, you gave $num_args\.\n/; +} diff --git a/lib/Test/Simple/t/missing.t b/lib/Test/Simple/t/missing.t index 7f451804b5..f8a4581c6e 100644 --- a/lib/Test/Simple/t/missing.t +++ b/lib/Test/Simple/t/missing.t @@ -33,6 +33,7 @@ require Test::Simple; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; Test::Simple->import(tests => 5); diff --git a/lib/Test/Simple/t/no_diag.t b/lib/Test/Simple/t/no_diag.t new file mode 100644 index 0000000000..21ecd03192 --- /dev/null +++ b/lib/Test/Simple/t/no_diag.t @@ -0,0 +1,6 @@ +#!/usr/bin/perl -w + +use Test::More 'no_diag', tests => 1; + +pass('foo'); +diag('This should not be displayed'); diff --git a/lib/Test/Simple/t/output.t b/lib/Test/Simple/t/output.t index dd051c15a6..72d0460277 100644 --- a/lib/Test/Simple/t/output.t +++ b/lib/Test/Simple/t/output.t @@ -9,6 +9,8 @@ BEGIN { unshift @INC, 't/lib'; } } +chdir 't'; + # Can't use Test.pm, that's a 5.005 thing. print "1..4\n"; @@ -33,7 +35,9 @@ use Test::Builder; my $Test = Test::Builder->new(); my $result; -my $out = $Test->output('foo'); +my $tmpfile = 'foo.tmp'; +my $out = $Test->output($tmpfile); +END { unlink($tmpfile) } ok( defined $out ); @@ -41,26 +45,25 @@ print $out "hi!\n"; close *$out; undef $out; -open(IN, 'foo') or die $!; +open(IN, $tmpfile) or die $!; chomp(my $line = <IN>); close IN; ok($line eq 'hi!'); -open(FOO, ">>foo") or die $!; +open(FOO, ">>$tmpfile") or die $!; $out = $Test->output(\*FOO); $old = select *$out; print "Hello!\n"; close *$out; undef $out; select $old; -open(IN, 'foo') or die $!; +open(IN, $tmpfile) or die $!; my @lines = <IN>; close IN; ok($lines[1] =~ /Hello!/); -unlink('foo'); # Ensure stray newline in name escaping works. diff --git a/lib/Test/Simple/t/overload.t b/lib/Test/Simple/t/overload.t new file mode 100644 index 0000000000..6b300add67 --- /dev/null +++ b/lib/Test/Simple/t/overload.t @@ -0,0 +1,53 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} +chdir 't'; + +BEGIN { + # There was a bug with overloaded objects and threads. + # See rt.cpan.org 4218 + eval { require threads; 'threads'->import; 1; }; +} + +use Test::More; + +BEGIN { + if( !eval "require overload" ) { + plan skip_all => "needs overload.pm"; + } + else { + plan tests => 3; + } +} + + +package Overloaded; + +use overload + q{""} => sub { $_[0]->{string} }; + +sub new { + my $class = shift; + bless { string => shift }, $class; +} + + +package main; + +my $warnings = ''; +local $SIG{__WARN__} = sub { $warnings = join '', @_ }; +my $obj = Overloaded->new('foo'); +ok( 1, $obj ); + +my $undef = Overloaded->new(undef); +pass( $undef ); + +is( $warnings, '' ); diff --git a/lib/Test/Simple/t/plan_is_noplan.t b/lib/Test/Simple/t/plan_is_noplan.t index 1ab2a0e8bd..e39cd4062b 100644 --- a/lib/Test/Simple/t/plan_is_noplan.t +++ b/lib/Test/Simple/t/plan_is_noplan.t @@ -11,20 +11,6 @@ BEGIN { # Can't use Test.pm, that's a 5.005 thing. package My::Test; -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"; - exit(0); - } -} - print "1..2\n"; my $test_num = 1; diff --git a/lib/Test/Simple/t/plan_no_plan.t b/lib/Test/Simple/t/plan_no_plan.t index b39b101cce..6ae06bf836 100644 --- a/lib/Test/Simple/t/plan_no_plan.t +++ b/lib/Test/Simple/t/plan_no_plan.t @@ -17,12 +17,15 @@ BEGIN { require Test::Harness; } -if( $Test::Harness::VERSION < 1.20 ) { - plan skip_all => 'Need Test::Harness 1.20 or up'; -} -else { - plan 'no_plan'; +# This feature requires a fairly new version of Test::Harness +if( $Test::Harness::VERSION < 2.03 ) { + plan tests => 1; + diag "Need Test::Harness 2.03 or up. You have $Test::Harness::VERSION."; + fail 'Need Test::Harness 2.03 or up'; + exit; } +plan 'no_plan'; + pass('Just testing'); ok(1, 'Testing again'); diff --git a/lib/Test/Simple/t/reset.t b/lib/Test/Simple/t/reset.t new file mode 100644 index 0000000000..bc1546bee6 --- /dev/null +++ b/lib/Test/Simple/t/reset.t @@ -0,0 +1,84 @@ +#!/usr/bin/perl -w + +# Test Test::Builder->reset; + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} +chdir 't'; + + +use Test::Builder; +my $tb = Test::Builder->new; +$tb->plan(tests => 14); +$tb->level(0); + +# Alter the state of Test::Builder as much as possible. +$tb->ok(1, "Running a test to alter TB's state"); + +my $tmpfile = 'foo.tmp'; + +$tb->output($tmpfile); +$tb->failure_output($tmpfile); +$tb->todo_output($tmpfile); +END { unlink $tmpfile } + +# This won't print since we just sent output off to oblivion. +$tb->ok(0, "And a failure for fun"); + +$Test::Builder::Level = 3; + +$tb->exported_to('Foofer'); + +$tb->use_numbers(0); +$tb->no_header(1); +$tb->no_ending(1); + + +# Now reset it. +$tb->reset; + +my $test_num = 2; # since we already printed 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++; + + return $test; +} + + +ok( !defined $tb->exported_to, 'exported_to' ); +ok( $tb->expected_tests == 0, 'expected_tests' ); +ok( $tb->level == 1, 'level' ); +ok( $tb->use_numbers == 1, 'use_numbers' ); +ok( $tb->no_header == 0, 'no_header' ); +ok( $tb->no_ending == 0, 'no_ending' ); +ok( fileno $tb->output == fileno *Test::Builder::TESTOUT, + 'output' ); +ok( fileno $tb->failure_output == fileno *Test::Builder::TESTERR, + 'failure_output' ); +ok( fileno $tb->todo_output == fileno *Test::Builder::TESTOUT, + 'todo_output' ); +ok( $tb->current_test == 0, 'current_test' ); +ok( $tb->summary == 0, 'summary' ); +ok( $tb->details == 0, 'details' ); + +$tb->no_ending(1); +$tb->no_header(1); +$tb->plan(tests => 14); +$tb->current_test(13); +$tb->level(0); +$tb->ok(1, 'final test to make sure output was reset'); diff --git a/lib/Test/Simple/t/thread_taint.t b/lib/Test/Simple/t/thread_taint.t new file mode 100644 index 0000000000..d547e6d8c4 --- /dev/null +++ b/lib/Test/Simple/t/thread_taint.t @@ -0,0 +1,5 @@ +#!/usr/bin/perl -w + +use Test::More tests => 1; + +ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' );
\ No newline at end of file diff --git a/lib/Test/Simple/t/threads.t b/lib/Test/Simple/t/threads.t index 5670bda25b..35696e2705 100644 --- a/lib/Test/Simple/t/threads.t +++ b/lib/Test/Simple/t/threads.t @@ -8,13 +8,16 @@ BEGIN { } use Config; -unless ($Config{'useithreads'} and eval { require threads; 1 }) { - print "1..0 # Skip: no threads\n"; - exit 0; +BEGIN { + unless ( $] >= 5.008 && $Config{'useithreads'} && + eval { require threads; 'threads'->import; 1; }) + { + print "1..0 # Skip: no threads\n"; + exit 0; + } } use strict; -require threads; use Test::Builder; my $Test = Test::Builder->new; diff --git a/lib/Test/Simple/t/todo.t b/lib/Test/Simple/t/todo.t index 31ceb5f634..9a16626a02 100644 --- a/lib/Test/Simple/t/todo.t +++ b/lib/Test/Simple/t/todo.t @@ -7,18 +7,20 @@ BEGIN { } } -BEGIN { - require Test::Harness; - use Test::More; - - if( $Test::Harness::VERSION < 1.23 ) { - plan skip_all => 'Need Test::Harness 1.23 or up'; - } - else { - plan tests => 15; - } +require Test::Harness; +use Test::More; + +# This feature requires a fairly new version of Test::Harness +(my $th_version = $Test::Harness::VERSION) =~ s/_//; # for X.Y_Z alpha versions +if( $th_version < 2.03 ) { + plan tests => 1; + fail "Need Test::Harness 2.03 or up. You have $th_version."; + exit; } +plan tests => 15; + + $Why = 'Just testing the todo interface.'; TODO: { diff --git a/lib/Test/Simple/t/use_ok.t b/lib/Test/Simple/t/use_ok.t index e944628176..d0c145f147 100644 --- a/lib/Test/Simple/t/use_ok.t +++ b/lib/Test/Simple/t/use_ok.t @@ -3,11 +3,14 @@ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = '../lib'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; } } -use Test::More tests => 10; +use Test::More tests => 13; # Using Symbol because it's core and exports lots of stuff. { @@ -36,3 +39,22 @@ use Test::More tests => 10; ::ok( defined &foo, 'constant' ); ::is( $warn, undef, 'no warning'); } + +{ + package Foo::five; + ::use_ok("Symbol", 1.02); +} + +{ + package Foo::six; + ::use_ok("NoExporter", 1.02); +} + +{ + package Foo::seven; + local $SIG{__WARN__} = sub { + # Old perls will warn on X.YY_ZZ style versions. Not our problem + warn @_ unless $_[0] =~ /^Argument "\d+\.\d+_\d+" isn't numeric/; + }; + ::use_ok("Test::More", 0.47); +} |