diff options
Diffstat (limited to 'gnu/usr.bin/perl/lib')
102 files changed, 977 insertions, 3569 deletions
diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/00test_harness_check.t b/gnu/usr.bin/perl/lib/Test/Simple/t/00test_harness_check.t index d50c8b5ffd5..99c626d9d9d 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/00test_harness_check.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/00test_harness_check.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: 00test_harness_check.t,v 1.2 2009/05/16 21:42:57 simon Exp $ # A test to make sure the new Test::Harness was installed properly. @@ -8,7 +9,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 <<INSTRUCTIONS; Test::Simple/More/Builder has features which depend on a version of diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/Builder/curr_test.t b/gnu/usr.bin/perl/lib/Test/Simple/t/Builder/curr_test.t new file mode 100644 index 00000000000..bd7b76a1fd1 --- /dev/null +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/Builder/curr_test.t @@ -0,0 +1,12 @@ +#!/usr/bin/perl -w +# $Id: curr_test.t,v 1.1 2009/05/16 21:42:57 simon Exp $ + +# Dave Rolsky found a bug where if current_test() is used and no +# tests are run via Test::Builder it will blow up. + +use Test::Builder; +$TB = Test::Builder->new; +$TB->plan(tests => 2); +print "ok 1\n"; +print "ok 2\n"; +$TB->current_test(2); diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/Builder/reset_outputs.t b/gnu/usr.bin/perl/lib/Test/Simple/t/Builder/reset_outputs.t new file mode 100644 index 00000000000..0622fe09f43 --- /dev/null +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/Builder/reset_outputs.t @@ -0,0 +1,36 @@ +#!perl -w +# $Id: reset_outputs.t,v 1.1 2009/05/16 21:42:58 simon Exp $ + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::Builder; +use Test::More 'no_plan'; + +{ + my $tb = Test::Builder->create(); + + # Store the original output filehandles and change them all. + my %original_outputs; + + open my $fh, ">", "dummy_file.tmp"; + END { 1 while unlink "dummy_file.tmp"; } + for my $method (qw(output failure_output todo_output)) { + $original_outputs{$method} = $tb->$method(); + $tb->$method($fh); + is $tb->$method(), $fh; + } + + $tb->reset_outputs; + + for my $method (qw(output failure_output todo_output)) { + is $tb->$method(), $original_outputs{$method}, "reset_outputs() resets $method"; + } +} diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/More.t b/gnu/usr.bin/perl/lib/Test/Simple/t/More.t index df8c5fea175..73d71d84ac0 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/More.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/More.t @@ -1,13 +1,15 @@ #!perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = '../lib'; + @INC = qw(../lib ../lib/Test/Simple/t/lib); } } -use Test::More tests => 41; +use lib 't/lib'; +use Test::More tests => 52; # Make sure we don't mess with $@ or $!. Test at bottom. my $Err = "this should not be touched"; @@ -15,7 +17,8 @@ my $Errno = 42; $@ = $Err; $! = $Errno; -use_ok('Text::Soundex'); +use_ok('Dummy'); +is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' ); require_ok('Test::More'); @@ -33,6 +36,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 @@ -64,10 +70,15 @@ pass('pass() passed'); ok( eq_array([qw(this that whatever)], [qw(this that whatever)]), 'eq_array with simple arrays' ); +is @Test::More::Data_Stack, 0, '@Data_Stack not holding onto things'; + ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}), 'eq_hash with simple hashes' ); +is @Test::More::Data_Stack, 0; + ok( eq_set([qw(this that whatever)], [qw(that whatever this)]), 'eq_set with simple sets' ); +is @Test::More::Data_Stack, 0; my @complex_array1 = ( [qw(this that whatever)], @@ -97,8 +108,11 @@ my @array2 = (qw(this that whatever), ok( !eq_array(\@array1, \@array2), 'eq_array with slightly different complicated arrays' ); +is @Test::More::Data_Stack, 0; + ok( !eq_set(\@array1, \@array2), 'eq_set with slightly different complicated arrays' ); +is @Test::More::Data_Stack, 0; my %hash1 = ( foo => 23, bar => [qw(this that whatever)], @@ -123,6 +137,7 @@ ok( eq_hash(\%hash1, \%hash2), 'eq_hash with complicated hashes'); ok( !eq_hash(\%hash1, \%hash2), 'eq_hash with slightly different complicated hashes' ); +is @Test::More::Data_Stack, 0; is( Test::Builder->new, Test::More->builder, 'builder()' ); @@ -144,6 +159,16 @@ cmp_ok(0, '||', 1, ' ||'); } isa_ok( Wibble->new, 'Wibblemeister' ); +my $sub = sub {}; +is_deeply( $sub, $sub, 'the same function ref' ); + +use Symbol; +my $glob = gensym; +is_deeply( $glob, $glob, 'the same glob' ); + +is_deeply( { foo => $sub, bar => [1, $glob] }, + { foo => $sub, bar => [1, $glob] } + ); # These two tests must remain at the end. is( $@, $Err, '$@ untouched' ); diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/bad_plan.t b/gnu/usr.bin/perl/lib/Test/Simple/t/bad_plan.t index 442fee86f09..1d4e50d6f0e 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/bad_plan.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/bad_plan.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/bail_out.t b/gnu/usr.bin/perl/lib/Test/Simple/t/bail_out.t index c05d0283d1c..8a281ce6c02 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/bail_out.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/bail_out.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: bail_out.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { @@ -28,7 +29,7 @@ my $Test = Test::Builder->create; $Test->level(0); if( $] >= 5.005 ) { - $Test->plan(tests => 2); + $Test->plan(tests => 3); } else { $Test->plan(skip_all => @@ -47,3 +48,5 @@ Bail out! ROCKS FALL! EVERYONE DIES! OUT $Test->is_eq( $Exit_Code, 255 ); + +$Test->ok( $Test->can("BAILOUT"), "Backwards compat" ); diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/buffer.t b/gnu/usr.bin/perl/lib/Test/Simple/t/buffer.t index 6039e4a6f72..04e92b92051 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/buffer.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/buffer.t @@ -1,4 +1,5 @@ #!/usr/bin/perl +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/circular_data.t b/gnu/usr.bin/perl/lib/Test/Simple/t/circular_data.t index 2fd819e1f4a..aee3a4b4c0b 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/circular_data.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/circular_data.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: circular_data.t,v 1.2 2009/05/16 21:42:57 simon Exp $ # Test is_deeply and friends with circular data structures [rt.cpan.org 7289] diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/cmp_ok.t b/gnu/usr.bin/perl/lib/Test/Simple/t/cmp_ok.t index b3642ad03e2..031940e49c1 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/cmp_ok.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/cmp_ok.t @@ -1,9 +1,10 @@ #!/usr/bin/perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = ('../lib', 'lib'); + @INC = ('../lib', 'lib', '../lib/Test/Simple/t/lib'); } else { unshift @INC, 't/lib'; @@ -29,19 +30,19 @@ sub try_cmp_ok { $expect{error} =~ s/ at .*\n?//; local $Test::Builder::Level = $Test::Builder::Level + 1; - my $ok = cmp_ok($left, $cmp, $right); - $TB->is_num(!!$ok, !!$expect{ok}); + my $ok = cmp_ok($left, $cmp, $right, "cmp_ok"); + $TB->is_num(!!$ok, !!$expect{ok}, " right return"); my $diag = $err->read; if( !$ok and $expect{error} ) { $diag =~ s/^# //mg; - $TB->like( $diag, "/\Q$expect{error}\E/" ); + $TB->like( $diag, qr/\Q$expect{error}\E/, " expected error" ); } elsif( $ok ) { - $TB->is_eq( $diag, '' ); + $TB->is_eq( $diag, '', " passed without diagnostic" ); } else { - $TB->ok(1); + $TB->ok(1, " failed without diagnostic"); } } @@ -49,6 +50,10 @@ sub try_cmp_ok { use Test::More; Test::More->builder->no_ending(1); +require MyOverload; +my $cmp = Overloaded::Compare->new("foo", 42); +my $ify = Overloaded::Ify->new("bar", 23); + my @Tests = ( [1, '==', 1], [1, '==', 2], @@ -56,23 +61,12 @@ my @Tests = ( ["a", "eq", "a"], [1, "+", 1], [1, "-", 1], -); -# These don't work yet. -if( 0 ) { -#if( eval { require overload } ) { - require MyOverload; - - my $cmp = Overloaded::Compare->new("foo", 42); - my $ify = Overloaded::Ify->new("bar", 23); - - push @Tests, ( - [$cmp, '==', 42], - [$cmp, 'eq', "foo"], - [$ify, 'eq', "bar"], - [$ify, "==", 23], - ); -} + [$cmp, '==', 42], + [$cmp, 'eq', "foo"], + [$ify, 'eq', "bar"], + [$ify, "==", 23], +); plan tests => scalar @Tests; $TB->plan(tests => @Tests * 2); diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/diag.t b/gnu/usr.bin/perl/lib/Test/Simple/t/diag.t index 453984b3c6e..91ef58f5884 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/diag.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/diag.t @@ -1,61 +1,90 @@ #!perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = '../lib'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; } } + +# Turn on threads here, if available, since this test tends to find +# lots of threading bugs. +use Config; +BEGIN { + if( $] >= 5.008001 && $Config{useithreads} ) { + require threads; + 'threads'->import; + } +} + + use strict; use Test::More tests => 7; -my $Test = Test::More->builder; +my $test = Test::Builder->create; # now make a filehandle where we can send data -my $output; -tie *FAKEOUT, 'FakeOut', \$output; +use TieOut; +my $output = tie *FAKEOUT, 'TieOut'; -# force diagnostic output to a filehandle, glad I added this to -# Test::Builder :) -my @lines; -my $ret; + +# Test diag() goes to todo_output() in a todo test. { - local $TODO = 1; - $Test->todo_output(\*FAKEOUT); + $test->todo_start(); + $test->todo_output(\*FAKEOUT); - diag("a single line"); + $test->diag("a single line"); + is( $output->read, <<'DIAG', 'diag() with todo_output set' ); +# a single line +DIAG - push @lines, $output; - $output = ''; + my $ret = $test->diag("multiple\n", "lines"); + is( $output->read, <<'DIAG', ' multi line' ); +# multiple +# lines +DIAG + ok( !$ret, 'diag returns false' ); - $ret = diag("multiple\n", "lines"); - push @lines, split(/\n/, $output); + $test->todo_end(); } -is( @lines, 3, 'diag() should send messages to its filehandle' ); -like( $lines[0], '/^#\s+/', ' should add comment mark to all lines' ); -is( $lines[0], "# a single line\n", ' should send exact message' ); -is( $output, "# multiple\n# lines\n", ' should append multi messages'); -ok( !$ret, 'diag returns false' ); +$test->reset_outputs(); + +# Test diagnostic formatting +$test->failure_output(\*FAKEOUT); { - $Test->failure_output(\*FAKEOUT); - $output = ''; - $ret = diag("# foo"); -} -$Test->failure_output(\*STDERR); -is( $output, "# # foo\n", "diag() adds a # even if there's one already" ); -ok( !$ret, 'diag returns false' ); + $test->diag("# foo"); + is( $output->read, "# # foo\n", "diag() adds # even if there's one already" ); -package FakeOut; + $test->diag("foo\n\nbar"); + is( $output->read, <<'DIAG', " blank lines get escaped" ); +# foo +# +# bar +DIAG -sub TIEHANDLE { - bless( $_[1], $_[0] ); + + $test->diag("foo\n\nbar\n\n"); + is( $output->read, <<'DIAG', " even at the end" ); +# foo +# +# bar +# +DIAG } -sub PRINT { - my $self = shift; - $$self .= join('', @_); + +# [rt.cpan.org 8392] +{ + $test->diag(qw(one two)); } +is( $output->read, <<'DIAG' ); +# onetwo +DIAG diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/eq_set.t b/gnu/usr.bin/perl/lib/Test/Simple/t/eq_set.t index fbdc52db1fa..75738c6081e 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/eq_set.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/eq_set.t @@ -1,4 +1,5 @@ #!perl -w +# $Id: eq_set.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/exit.t b/gnu/usr.bin/perl/lib/Test/Simple/t/exit.t index 1367bbfdcd3..6c6945ca212 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/exit.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/exit.t @@ -1,3 +1,6 @@ +#!/usr/bin/perl -w +# $Id$ + # Can't use Test.pm, that's a 5.005 thing. package My::Test; @@ -23,18 +26,9 @@ if( $^O eq 'MacOS' ) { exit 0; } -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++; -} +require Test::Builder; +my $TB = Test::Builder->create(); +$TB->level(0); package main; @@ -49,15 +43,19 @@ my %Tests = ( 'one_fail.plx' => [1, 4], 'two_fail.plx' => [2, 4], 'five_fail.plx' => [5, 4], - 'extras.plx' => [3, 4], - 'too_few.plx' => [4, 4], + 'extras.plx' => [2, 4], + 'too_few.plx' => [255, 4], + 'too_few_fail.plx' => [2, 4], 'death.plx' => [255, 4], 'last_minute_death.plx' => [255, 4], + 'pre_plan_death.plx' => ['not zero', 'not zero'], 'death_in_eval.plx' => [0, 0], 'require.plx' => [0, 0], + 'death_with_handler.plx' => [255, 4], + 'exit.plx' => [1, 4], ); -print "1..".keys(%Tests)."\n"; +$TB->plan( tests => scalar keys(%Tests) ); eval { require POSIX; &POSIX::WEXITSTATUS(0) }; if( $@ ) { @@ -67,13 +65,13 @@ else { *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) } } +my $Perl = File::Spec->rel2abs($^X); + chdir 't'; my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests)); while( my($test_name, $exit_codes) = each %Tests ) { my($exit_code) = $exit_codes->[$IsVMS ? 1 : 0]; - my $Perl = $^X; - if( $^O eq 'VMS' ) { # VMS can't use its own $^X in a system call until almost 5.8 $Perl = "MCR $^X" if $] < 5.007003; @@ -87,6 +85,14 @@ while( my($test_name, $exit_codes) = each %Tests ) { my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file}); my $actual_exit = exitstatus($wait_stat); - My::Test::ok( $actual_exit == $exit_code, - "$test_name exited with $actual_exit (expected $exit_code)"); + if( $exit_code eq 'not zero' ) { + $TB->isnt_num( $actual_exit, 0, + "$test_name exited with $actual_exit ". + "(expected $exit_code)"); + } + else { + $TB->is_num( $actual_exit, $exit_code, + "$test_name exited with $actual_exit ". + "(expected $exit_code)"); + } } diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/extra.t b/gnu/usr.bin/perl/lib/Test/Simple/t/extra.t index 1ed94adb77e..778284da43e 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/extra.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/extra.t @@ -1,4 +1,5 @@ #!perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -10,20 +11,11 @@ BEGIN { # 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++; -} +# This has to be a require or else the END block below runs before +# Test::Builder's own and the ending diagnostics don't come out right. +require Test::Builder; +my $TB = Test::Builder->create; +$TB->plan(tests => 2); package main; @@ -34,6 +26,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); @@ -45,7 +38,7 @@ ok(1, 'Car'); ok(0, 'Sar'); END { - My::Test::ok($$out eq <<OUT); + $TB->is_eq($$out, <<OUT); 1..3 ok 1 - Foo not ok 2 - Bar @@ -54,10 +47,13 @@ ok 4 - Car not ok 5 - Sar OUT - My::Test::ok($$err eq <<ERR); -# Failed test ($0 at line 31) -# Failed test ($0 at line 34) -# Looks like you planned 3 tests but ran 2 extra. + $TB->is_eq($$err, <<ERR); +# Failed test 'Bar' +# at $0 line 31. +# Failed test 'Sar' +# at $0 line 34. +# Looks like you planned 3 tests but ran 5. +# Looks like you failed 2 tests of 5 run. ERR exit 0; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/extra_one.t b/gnu/usr.bin/perl/lib/Test/Simple/t/extra_one.t index 30830d3e378..3d8b248d5b7 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/extra_one.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/extra_one.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: extra_one.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { @@ -44,7 +45,7 @@ ok 3 OUT My::Test::is($$err, <<ERR); -# Looks like you planned 1 test but ran 2 extra. +# Looks like you planned 1 test but ran 3. ERR # Prevent Test::Simple from existing with non-zero diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/fail-like.t b/gnu/usr.bin/perl/lib/Test/Simple/t/fail-like.t index 13367633cd2..d1a51d49e14 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/fail-like.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/fail-like.t @@ -1,11 +1,5 @@ -# qr// was introduced in 5.004-devel. Skip this test if we're not -# of high enough version. -BEGIN { - if( $] < 5.005 ) { - print "1..0\n"; - exit(0); - } -} +#!/usr/bin/perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -22,27 +16,20 @@ BEGIN { 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++; -} +# This has to be a require or else the END block below runs before +# Test::Builder's own and the ending diagnostics don't come out right. +require Test::Builder; +my $TB = Test::Builder->create; +$TB->plan(tests => 4); + + +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; package main; @@ -50,24 +37,39 @@ package main; require Test::More; Test::More->import(tests => 1); -eval q{ like( "foo", qr/that/, 'is foo like that' ); }; +{ + eval q{ like( "foo", qr/that/, 'is foo like that' ); }; - -END { - My::Test::ok($$out eq <<OUT, 'failing output'); + $TB->is_eq($out->read, <<OUT, 'failing output'); 1..1 not ok 1 - is foo like that OUT my $err_re = <<ERR; -# Failed test \\(.*\\) +# Failed test 'is foo like that' +# at .* line 1\. # 'foo' # doesn't match '\\(\\?-xism:that\\)' -# Looks like you failed 1 tests of 1\\. ERR + $TB->like($err->read, qr/^$err_re$/, 'failing errors'); +} - My::Test::ok($$err =~ /^$err_re$/, 'failing errors'); +{ + # line 60 + like("foo", "not a regex"); + $TB->is_eq($out->read, <<OUT); +not ok 2 +OUT - exit(0); + $TB->is_eq($err->read, <<OUT); +# Failed test at $0 line 60. +# 'not a regex' doesn't look much like a regex to me. +OUT + +} + +END { + # Test::More thinks it failed. Override that. + exit(scalar grep { !$_ } $TB->summary); } diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/fail-more.t b/gnu/usr.bin/perl/lib/Test/Simple/t/fail-more.t index 29f8eb25ac0..4e515c5fb85 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/fail-more.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/fail-more.t @@ -1,4 +1,5 @@ #!perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -14,210 +15,375 @@ 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; +# This has to be a require or else the END block below runs before +# Test::Builder's own and the ending diagnostics don't come out right. +require Test::Builder; +my $TB = Test::Builder->create; +$TB->plan(tests => 23); + +sub like ($$;$) { + $TB->like(@_); +} + +sub is ($$;$) { + $TB->is_eq(@_); +} + +sub main::err_ok ($) { + my($expect) = @_; + my $got = $err->read; + + return $TB->is_eq( $got, $expect ); +} + +sub main::err_like ($) { + my($expect) = @_; + my $got = $err->read; + + return $TB->like( $got, qr/$expect/ ); } package main; require Test::More; -my $Total = 28; +my $Total = 36; Test::More->import(tests => $Total); +# This should all work in the presence of a __DIE__ handler. +local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); }; + + +my $tb = Test::More->builder; +$tb->use_numbers(0); + +my $Filename = quotemeta $0; + # Preserve the line numbers. #line 38 ok( 0, 'failing' ); +err_ok( <<ERR ); +# Failed test 'failing' +# at $0 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?' ); +err_ok( <<ERR ); +# Failed test 'foo is bar?' +# at $0 line 40. +# got: 'foo' +# expected: 'bar' +# Failed test 'undef is empty string?' +# at $0 line 41. +# got: undef +# expected: '' +# Failed test 'undef is 0?' +# at $0 line 42. +# got: undef +# expected: '0' +# Failed test 'empty string is 0?' +# at $0 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_ok( <<ERR ); +# Failed test 'foo isnt foo?' +# at $0 line 45. +# got: 'foo' +# expected: anything else +# Failed test 'foo isn\'t foo?' +# at $0 line 46. +# got: 'foo' +# expected: anything else +# Failed test 'undef isnt undef?' +# at $0 line 47. +# got: undef +# expected: anything else +ERR +#line 48 like( "foo", '/that/', 'is foo like that' ); unlike( "foo", '/foo/', 'is foo unlike foo' ); +err_ok( <<ERR ); +# Failed test 'is foo like that' +# at $0 line 48. +# 'foo' +# doesn't match '/that/' +# Failed test 'is foo unlike foo' +# at $0 line 49. +# 'foo' +# matches '/foo/' +ERR # Nick Clark found this was a bug. Fixed in 0.40. +# line 60 like( "bug", '/(%)/', 'regex with % in it' ); +err_ok( <<ERR ); +# Failed test 'regex with % in it' +# at $0 line 60. +# 'bug' +# doesn't match '/(%)/' +ERR +#line 67 fail('fail()'); +err_ok( <<ERR ); +# Failed test 'fail()' +# at $0 line 67. +ERR #line 52 can_ok('Mooble::Hooble::Yooble', qw(this that)); can_ok('Mooble::Hooble::Yooble', ()); +can_ok(undef, undef); +can_ok([], "foo"); +err_ok( <<ERR ); +# Failed test 'Mooble::Hooble::Yooble->can(...)' +# at $0 line 52. +# Mooble::Hooble::Yooble->can('this') failed +# Mooble::Hooble::Yooble->can('that') failed +# Failed test 'Mooble::Hooble::Yooble->can(...)' +# at $0 line 53. +# can_ok() called with no methods +# Failed test '->can(...)' +# at $0 line 54. +# can_ok() called with empty class or reference +# Failed test 'ARRAY->can('foo')' +# at $0 line 55. +# ARRAY->can('foo') failed +ERR +#line 55 isa_ok(bless([], "Foo"), "Wibble"); isa_ok(42, "Wibble", "My Wibble"); isa_ok(undef, "Wibble", "Another Wibble"); isa_ok([], "HASH"); +err_ok( <<ERR ); +# Failed test 'The object isa Wibble' +# at $0 line 55. +# The object isn't a 'Wibble' it's a 'Foo' +# Failed test 'My Wibble isa Wibble' +# at $0 line 56. +# My Wibble isn't a reference +# Failed test 'Another Wibble isa Wibble' +# at $0 line 57. +# Another Wibble isn't defined +# Failed test 'The object isa HASH' +# at $0 line 58. +# The object isn't a 'HASH' it's a 'ARRAY' +ERR + + +#line 188 +new_ok(undef); +err_like( <<ERR ); +# Failed test 'new\\(\\) died' +# at $Filename line 188. +# Error was: Can't call method "new" on an undefined value at .* +ERR + +#line 211 +new_ok( "Does::Not::Exist" ); +err_like( <<ERR ); +# Failed test 'new\\(\\) died' +# at $Filename line 211. +# Error was: Can't locate object method "new" via package "Does::Not::Exist" .* +ERR + +{ package Foo; sub new { } } +{ package Bar; sub new { {} } } +{ package Baz; sub new { bless {}, "Wibble" } } + +#line 219 +new_ok( "Foo" ); +err_ok( <<ERR ); +# Failed test 'The object isa Foo' +# at $0 line 219. +# The object isn't defined +ERR + +# line 231 +new_ok( "Bar" ); +err_ok( <<ERR ); +# Failed test 'The object isa Bar' +# at $0 line 231. +# The object isn't a 'Bar' it's a 'HASH' +ERR + +#line 239 +new_ok( "Baz" ); +err_ok( <<ERR ); +# Failed test 'The object isa Baz' +# at $0 line 239. +# The object isn't a 'Baz' it's a 'Wibble' +ERR + +#line 247 +new_ok( "Baz", [], "no args" ); +err_ok( <<ERR ); +# Failed test 'no args isa Baz' +# at $0 line 247. +# no args isn't a 'Baz' it's a 'Wibble' +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' ); - -# 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) -# Failed test ($0 at line 40) -# got: 'foo' -# expected: 'bar' -# Failed test ($0 at line 41) -# got: undef -# expected: '' -# Failed test ($0 at line 42) -# got: undef -# expected: '0' -# Failed test ($0 at line 43) -# got: '' -# expected: '0' -# Failed test ($0 at line 45) -# 'foo' -# ne -# 'foo' -# Failed test ($0 at line 46) -# 'foo' -# ne -# 'foo' -# 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) -# 'bug' -# doesn't match '/(%)/' -# Failed test ($0 at line 54) -# 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 -# Failed test ($0 at line 55) -# The object isn't a 'Wibble' it's a 'Foo' -# Failed test ($0 at line 56) -# My Wibble isn't a reference -# Failed test ($0 at line 57) -# Another Wibble isn't defined -# Failed test ($0 at line 58) -# The object isn't a 'HASH' it's a 'ARRAY' -# Failed test ($0 at line 68) +err_ok( <<ERR ); +# Failed test 'cmp_ok eq' +# at $0 line 68. # got: 'foo' # expected: 'bar' -# Failed test ($0 at line 69) +# Failed test ' ==' +# at $0 line 69. # got: 42.1 # expected: 23 -# Failed test ($0 at line 70) -# '42' -# != -# '42' -# Failed test ($0 at line 71) +# Failed test ' !=' +# at $0 line 70. +# got: 42 +# expected: anything else +# Failed test ' &&' +# at $0 line 71. # '1' # && # '0' -# Failed test ($0 at line 72) -# got: 42 -# expected: 0 -# Failed test ($0 at line 73) +ERR + + +# line 196 +cmp_ok( 42, 'eq', "foo", ' eq with numbers' ); +err_ok( <<ERR ); +# Failed test ' eq with numbers' +# at $0 line 196. # got: '42' # expected: 'foo' -# Failed test ($0 at line 74) -# got: undef -# expected: 'foo' -# Failed test ($0 at line 80) +ERR + + +{ + my $warnings; + local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; + +# line 211 + cmp_ok( 42, '==', "foo", ' == with strings' ); + err_ok( <<ERR ); +# Failed test ' == with strings' +# at $0 line 211. +# got: 42 +# expected: foo +ERR + My::Test::like $warnings, + qr/^Argument "foo" isn't numeric in .* at cmp_ok \[from $Filename line 211\] line 1\.\n$/; + +} + + +# 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_ok( <<ERR ); +# Failed test ' eq with stringified errno' +# at $0 line 80. # got: '$Errno_String' # expected: '' -# Failed test ($0 at line 81) +# Failed test ' eq with numerified errno' +# at $0 line 81. # got: $Errno_Number # expected: -1 ERR - my $filename = quotemeta $0; - my $more_err_re = <<ERR; -# Failed test \\($filename at line 84\\) +#line 84 +use_ok('Hooble::mooble::yooble'); + +my $more_err_re = <<ERR; +# Failed test 'use Hooble::mooble::yooble;' +# at $Filename line 84\\. # Tried to use 'Hooble::mooble::yooble'. # Error: Can't locate Hooble.* in \\\@INC .* -# Failed test \\($filename at line 85\\) +ERR + +My::Test::like($err->read, "/^$more_err_re/"); + + +#line 85 +require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'); +$more_err_re = <<ERR; +# Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;' +# at $Filename 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$/, - 'failing errors') ) { - print $$err; - } +My::Test::like($err->read, "/^$more_err_re/"); + + +#line 88 +END { + $TB->is_eq($$out, <<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 - ->can(...) +not ok - ARRAY->can('foo') +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 - new() died +not ok - new() died +not ok - The object isa Foo +not ok - The object isa Bar +not ok - The object isa Baz +not ok - no args isa Baz +not ok - cmp_ok eq +not ok - == +not ok - != +not ok - && +not ok - eq with numbers +not ok - == with strings +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 + +err_ok( <<ERR ); +# Looks like you failed $Total tests of $Total. +ERR exit(0); } diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/fail.t b/gnu/usr.bin/perl/lib/Test/Simple/t/fail.t index a041ab0eb9b..fd272d17bf4 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/fail.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/fail.t @@ -1,4 +1,5 @@ #!perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -14,6 +15,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. @@ -59,8 +61,10 @@ not ok 5 - damnit OUT My::Test::ok($$err eq <<ERR); -# Failed test ($0 at line 38) -# Failed test ($0 at line 39) +# Failed test 'oh no!' +# at $0 line 38. +# Failed test 'damnit' +# at $0 line 39. # Looks like you failed 2 tests of 5. ERR diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/fail_one.t b/gnu/usr.bin/perl/lib/Test/Simple/t/fail_one.t index fe226247410..91c671c6fd8 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/fail_one.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/fail_one.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: fail_one.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { @@ -53,7 +54,7 @@ not ok 1 OUT My::Test::ok($$err eq <<ERR) || print $$err; -# Failed test in $0 at line 45. +# Failed test at $0 line 45. # Looks like you failed 1 test of 1. ERR diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/filehandles.t b/gnu/usr.bin/perl/lib/Test/Simple/t/filehandles.t index dfea4ba48e0..1e20470f277 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/filehandles.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/filehandles.t @@ -1,21 +1,19 @@ #!perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = '../lib'; + @INC = ('../lib', 'lib'); } } +use lib 't/lib'; use Test::More tests => 1; +use Dev::Null; tie *STDOUT, "Dev::Null" or die $!; print "not ok 1\n"; # this should not print. pass 'STDOUT can be mucked with'; - -package Dev::Null; - -sub TIEHANDLE { bless {} } -sub PRINT { 1 } diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/fork.t b/gnu/usr.bin/perl/lib/Test/Simple/t/fork.t index ca103b1ca64..02cd73b44ce 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/fork.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/fork.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: fork.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { @@ -10,7 +11,13 @@ BEGIN { use Test::More; use Config; -if( !$Config{d_fork} ) { +my $Can_Fork = $Config{d_fork} || + (($^O eq 'MSWin32' || $^O eq 'NetWare') and + $Config{useithreads} and + $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ + ); + +if( !$Can_Fork ) { plan skip_all => "This system cannot fork"; } else { @@ -23,3 +30,4 @@ if( fork ) { # parent else { exit; # child } + diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/harness_active.t b/gnu/usr.bin/perl/lib/Test/Simple/t/harness_active.t index d3ae56a8282..409fa4f6350 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/harness_active.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/harness_active.t @@ -1,4 +1,5 @@ #!perl -w +# $Id: harness_active.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { @@ -52,13 +53,13 @@ Test::More->builder->no_ending(1); fail( "this fails" ); err_ok( <<ERR ); # Failed test 'this fails' -# in $0 at line 62. +# at $0 line 62. ERR #line 72 is( 1, 0 ); err_ok( <<ERR ); -# Failed test in $0 at line 72. +# Failed test at $0 line 72. # got: '1' # expected: '0' ERR @@ -72,7 +73,7 @@ ERR err_ok( <<ERR ); # Failed test 'this fails' -# in $0 at line 71. +# at $0 line 71. ERR @@ -80,7 +81,7 @@ ERR is( 1, 0 ); err_ok( <<ERR ); -# Failed test in $0 at line 84. +# Failed test at $0 line 84. # got: '1' # expected: '0' ERR diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/import.t b/gnu/usr.bin/perl/lib/Test/Simple/t/import.t index 68a36138bc9..fd2aef40ba2 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/import.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/import.t @@ -1,3 +1,4 @@ +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_dne_bug.t b/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_dne_bug.t index 56515f90597..43cdce9786b 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_dne_bug.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_dne_bug.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id$ # test for rt.cpan.org 20768 # @@ -16,16 +17,7 @@ BEGIN { } use strict; -use Test::More; - -BEGIN { - if( !eval "require overload" ) { - plan skip_all => "needs overload.pm"; - } - else { - plan tests => 2; - } -} +use Test::More tests => 2; { package Foo; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_fail.t b/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_fail.t index efbbddd7b2e..044a6595272 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_fail.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_fail.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: is_deeply_fail.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { @@ -64,7 +65,7 @@ ok !is_deeply('foo', 'bar', 'plain strings'); is( $out, "not ok 1 - plain strings\n", 'plain strings' ); is( $err, <<ERR, ' right diagnostic' ); # Failed test 'plain strings' -# in $0 at line 68. +# at $0 line 68. # got: 'foo' # expected: 'bar' ERR @@ -75,7 +76,7 @@ ok !is_deeply({}, [], 'different types'); is( $out, "not ok 2 - different types\n", 'different types' ); like( $err, <<ERR, ' right diagnostic' ); # Failed test 'different types' -# in $Filename at line 78. +# at $Filename line 78. # Structures begin differing at: # \\\$got = HASH\\(0x[0-9a-f]+\\) # \\\$expected = ARRAY\\(0x[0-9a-f]+\\) @@ -87,7 +88,7 @@ is( $out, "not ok 3 - hashes with different values\n", 'hashes with different values' ); is( $err, <<ERR, ' right diagnostic' ); # Failed test 'hashes with different values' -# in $0 at line 88. +# at $0 line 88. # Structures begin differing at: # \$got->{this} = '42' # \$expected->{this} = '43' @@ -99,7 +100,7 @@ is( $out, "not ok 4 - hashes with different keys\n", 'hashes with different keys' ); is( $err, <<ERR, ' right diagnostic' ); # Failed test 'hashes with different keys' -# in $0 at line 99. +# at $0 line 99. # Structures begin differing at: # \$got->{this} = Does not exist # \$expected->{this} = '42' @@ -111,7 +112,7 @@ is( $out, "not ok 5 - arrays of different length\n", 'arrays of different length' ); is( $err, <<ERR, ' right diagnostic' ); # Failed test 'arrays of different length' -# in $0 at line 110. +# at $0 line 110. # Structures begin differing at: # \$got->[9] = Does not exist # \$expected->[9] = '10' @@ -122,7 +123,7 @@ ok !is_deeply([undef, undef], [undef], 'arrays of undefs' ); is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' ); is( $err, <<ERR, ' right diagnostic' ); # Failed test 'arrays of undefs' -# in $0 at line 121. +# at $0 line 121. # Structures begin differing at: # \$got->[1] = undef # \$expected->[1] = Does not exist @@ -133,7 +134,7 @@ ok !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 'hashes of undefs' -# in $0 at line 131. +# at $0 line 131. # Structures begin differing at: # \$got->{foo} = undef # \$expected->{foo} = Does not exist @@ -144,7 +145,7 @@ ok !is_deeply(\42, \23, 'scalar refs'); is( $out, "not ok 8 - scalar refs\n", 'scalar refs' ); is( $err, <<ERR, ' right diagnostic' ); # Failed test 'scalar refs' -# in $0 at line 141. +# at $0 line 141. # Structures begin differing at: # \${ \$got} = '42' # \${\$expected} = '23' @@ -156,7 +157,7 @@ is( $out, "not ok 9 - mixed scalar and array refs\n", 'mixed scalar and array refs' ); like( $err, <<ERR, ' right diagnostic' ); # Failed test 'mixed scalar and array refs' -# in $Filename at line 151. +# at $Filename line 151. # Structures begin differing at: # \\\$got = ARRAY\\(0x[0-9a-f]+\\) # \\\$expected = SCALAR\\(0x[0-9a-f]+\\) @@ -176,7 +177,7 @@ ok !is_deeply($a1, $b1, 'deep scalar refs'); is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' ); is( $err, <<ERR, ' right diagnostic' ); # Failed test 'deep scalar refs' -# in $0 at line 173. +# at $0 line 173. # Structures begin differing at: # \${\${ \$got}} = '42' # \${\${\$expected}} = '23' @@ -203,7 +204,7 @@ ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); is( $out, "not ok 11 - deep structures\n", 'deep structures' ); is( $err, <<ERR, ' right diagnostic' ); # Failed test 'deep structures' -# in $0 at line 198. +# at $0 line 198. # Structures begin differing at: # \$got->{that}{foo} = Does not exist # \$expected->{that}{foo} = '42' @@ -252,7 +253,7 @@ $$err = $$out = ''; ok !is_deeply( [\'a', 'b'], [\'a', 'c'] ); is( $out, "not ok 20\n", 'scalar refs in an array' ); is( $err, <<ERR, ' right diagnostic' ); -# Failed test in $0 at line 274. +# Failed test at $0 line 274. # Structures begin differing at: # \$got->[1] = 'b' # \$expected->[1] = 'c' @@ -264,7 +265,7 @@ my $ref = \23; ok !is_deeply( 23, $ref ); is( $out, "not ok 21\n", 'scalar vs ref' ); is( $err, <<ERR, ' right diagnostic'); -# Failed test in $0 at line 286. +# Failed test at $0 line 286. # Structures begin differing at: # \$got = '23' # \$expected = $ref @@ -274,7 +275,7 @@ ERR ok !is_deeply( $ref, 23 ); is( $out, "not ok 22\n", 'ref vs scalar' ); is( $err, <<ERR, ' right diagnostic'); -# Failed test in $0 at line 296. +# Failed test at $0 line 296. # Structures begin differing at: # \$got = $ref # \$expected = '23' @@ -284,7 +285,7 @@ ERR ok !is_deeply( undef, [] ); is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' ); like( $err, <<ERR, ' right diagnostic' ); -# Failed test in $Filename at line 306\\. +# Failed test at $Filename line 306\\. # Structures begin differing at: # \\\$got = undef # \\\$expected = ARRAY\\(0x[0-9a-f]+\\) @@ -300,7 +301,7 @@ ERR ok !is_deeply( $array, $hash ); is( $out, "not ok 24\n", 'is_deeply and different reference types' ); is( $err, <<ERR, ' right diagnostic' ); -# Failed test in $0 at line 321. +# Failed test at $0 line 321. # Structures begin differing at: # \$got = $array # \$expected = $hash @@ -310,14 +311,15 @@ ERR ok !is_deeply( [$array], [$hash] ); is( $out, "not ok 25\n", 'nested different ref types' ); is( $err, <<ERR, ' right diagnostic' ); -# Failed test in $0 at line 332. +# Failed test at $0 line 332. # Structures begin differing at: # \$got->[0] = $array # \$expected->[0] = $hash ERR - if( eval { require overload } ) { + # Overloaded object tests + { my $foo = bless [], "Foo"; my $bar = bless {}, "Bar"; @@ -330,16 +332,13 @@ ERR ok !is_deeply( [$foo], [$bar] ); is( $out, "not ok 26\n", 'string overloaded refs respected in diag' ); is( $err, <<ERR, ' right diagnostic' ); -# Failed test in $0 at line 353. +# Failed test at $0 line 353. # Structures begin differing at: # \$got->[0] = $foo # \$expected->[0] = 'wibble' ERR } - else { - $TB->skip("Needs overload.pm") for 1..3; - } } @@ -349,7 +348,7 @@ ERR ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs'; is( $out, "not ok 27\n" ); like( $err, <<ERR, ' right diagnostic' ); -# Failed test in $Filename at line 349. +# Failed test at $Filename line 349. # Structures begin differing at: # \\\$got = CODE\\(0x[0-9a-f]+\\) # \\\$expected = CODE\\(0x[0-9a-f]+\\) @@ -364,7 +363,7 @@ ERR ok !is_deeply( $glob1, $glob2 ), 'typeglobs'; is( $out, "not ok 28\n" ); like( $err, <<ERR, ' right diagnostic' ); -# Failed test in $0 at line 357. +# Failed test at $Filename line 357. # Structures begin differing at: # \\\$got = GLOB\\(0x[0-9a-f]+\\) # \\\$expected = GLOB\\(0x[0-9a-f]+\\) diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_with_threads.t b/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_with_threads.t index a9e2e5aae0d..634bba30e97 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_with_threads.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/is_deeply_with_threads.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id$ # Test to see if is_deeply() plays well with threads. @@ -19,7 +20,12 @@ BEGIN { unless ( $] >= 5.008001 && $Config{'useithreads'} && eval { require threads; 'threads'->import; 1; }) { - print "1..0 # Skip: no working threads\n"; + print "1..0 # Skip no working threads\n"; + exit 0; + } + + unless ( $ENV{AUTHOR_TESTING} ) { + print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n"; exit 0; } } @@ -27,7 +33,7 @@ use Test::More; my $Num_Threads = 5; -plan tests => $Num_Threads * 100 + 5; +plan tests => $Num_Threads * 100 + 6; sub do_one_thread { @@ -56,3 +62,5 @@ for my $t (@kids) { my $rc = $t->join(); cmp_ok( $rc, '==', 42, "threads exit status is $rc" ); } + +pass("End of test"); diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/lib/Dummy.pm b/gnu/usr.bin/perl/lib/Test/Simple/t/lib/Dummy.pm index 5e5b439d8cd..e0cf30abc95 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/lib/Dummy.pm +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/lib/Dummy.pm @@ -1,5 +1,6 @@ package Dummy; +# $Id$ $VERSION = '0.01'; -1;
\ No newline at end of file +1; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/lib/MyOverload.pm b/gnu/usr.bin/perl/lib/Test/Simple/t/lib/MyOverload.pm index 91632e99e7b..6d78b937738 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/lib/MyOverload.pm +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/lib/MyOverload.pm @@ -1,11 +1,11 @@ package Overloaded; +# $Id$ sub new { my $class = shift; bless { string => shift, num => shift }, $class; } - package Overloaded::Compare; use vars qw(@ISA); @ISA = qw(Overloaded); @@ -13,17 +13,15 @@ use vars qw(@ISA); # Sometimes objects have only comparison ops overloaded and nothing else. # For example, DateTime objects. use overload - q{eq} => sub { $_[0]->{string} eq $_[1] }, - q{==} => sub { $_[0]->{num} == $_[1] }; - - + q{eq} => sub { $_[0]->{string} eq $_[1] }, + q{==} => sub { $_[0]->{num} == $_[1] }; package Overloaded::Ify; use vars qw(@ISA); @ISA = qw(Overloaded); use overload - q{""} => sub { $_[0]->{string} }, - q{0+} => sub { $_[0]->{num} }; + q{""} => sub { $_[0]->{string} }, + q{0+} => sub { $_[0]->{num} }; -1;
\ No newline at end of file +1; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/lib/TieOut.pm b/gnu/usr.bin/perl/lib/Test/Simple/t/lib/TieOut.pm new file mode 100644 index 00000000000..e8d48261397 --- /dev/null +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/lib/TieOut.pm @@ -0,0 +1,29 @@ +package TieOut; +# $Id: TieOut.pm,v 1.1 2009/05/16 21:42:58 simon Exp $ + +sub TIEHANDLE { + my $scalar = ''; + bless( \$scalar, $_[0] ); +} + +sub PRINT { + my $self = shift; + $$self .= join( '', @_ ); +} + +sub PRINTF { + my $self = shift; + my $fmt = shift; + $$self .= sprintf $fmt, @_; +} + +sub FILENO { } + +sub read { + my $self = shift; + my $data = $$self; + $$self = ''; + return $data; +} + +1; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/missing.t b/gnu/usr.bin/perl/lib/Test/Simple/t/missing.t index 7f451804b5b..11f2443e756 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/missing.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/missing.t @@ -1,3 +1,4 @@ +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @@ -11,20 +12,13 @@ BEGIN { # 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++; -} +# This has to be a require or else the END block below runs before +# Test::Builder's own and the ending diagnostics don't come out right. +require Test::Builder; +my $TB = Test::Builder->create; +$TB->plan(tests => 2); + +sub is { $TB->is_eq(@_) } package main; @@ -33,23 +27,30 @@ require Test::Simple; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; Test::Simple->import(tests => 5); #line 30 ok(1, 'Foo'); ok(0, 'Bar'); +ok(1, '1 2 3'); END { - My::Test::ok($$out eq <<OUT); + My::Test::is($$out, <<OUT); 1..5 ok 1 - Foo not ok 2 - Bar +ok 3 - 1 2 3 OUT - My::Test::ok($$err eq <<ERR); -# Failed test ($0 at line 31) -# Looks like you planned 5 tests but only ran 2. + My::Test::is($$err, <<ERR); +# Failed test 'Bar' +# at $0 line 31. +# You named your test '1 2 3'. You shouldn't use numbers for your test names. +# Very confusing. +# Looks like you planned 5 tests but ran 3. +# Looks like you failed 1 test of 3 run. ERR exit 0; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/no_plan.t b/gnu/usr.bin/perl/lib/Test/Simple/t/no_plan.t index c0af2d4647e..10e85abda9d 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/no_plan.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/no_plan.t @@ -1,3 +1,6 @@ +#!/usr/bin/perl -w +# $Id$ + BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @@ -8,66 +11,29 @@ BEGIN { } } -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -print "1..12\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; - -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); - -eval { - Test::Simple->import; -}; - -My::Test::ok($$out eq ''); -My::Test::ok($$err eq ''); -My::Test::ok($@ eq ''); - -eval { - Test::Simple->import(tests => undef); -}; - -My::Test::ok($$out eq ''); -My::Test::ok($$err eq ''); -My::Test::ok($@ =~ /Got an undefined number of tests/); +use Test::More tests => 9; -eval { - Test::Simple->import(tests => 0); -}; +my $tb = Test::Builder->create; +$tb->level(0); -My::Test::ok($$out eq ''); -My::Test::ok($$err eq ''); -My::Test::ok($@ =~ /You said to run 0 tests!/); +#line 20 +ok !eval { $tb->plan(tests => undef) }; +is($@, "Got an undefined number of tests at $0 line 20.\n"); -eval { - Test::Simple::ok(1); -}; -My::Test::ok( $@ =~ /You tried to run a test without a plan!/); +#line 24 +ok !eval { $tb->plan(tests => 0) }; +is($@, "You said to run 0 tests at $0 line 24.\n"); +#line 28 +ok !eval { $tb->ok(1) }; +is( $@, "You tried to run a test without a plan at $0 line 28.\n"); -END { - My::Test::ok($$out eq ''); - My::Test::ok($$err eq ""); +{ + my $warning = ''; + local $SIG{__WARN__} = sub { $warning .= join '', @_ }; - # Prevent Test::Simple from exiting with non zero. - exit 0; +#line 36 + ok $tb->plan(no_plan => 1); + is( $warning, "no_plan takes no arguments at $0 line 36.\n" ); + is $tb->has_plan, 'no_plan'; } diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/overload.t b/gnu/usr.bin/perl/lib/Test/Simple/t/overload.t index e0e70d42296..fb74c59b078 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/overload.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/overload.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: overload.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { @@ -11,38 +12,45 @@ BEGIN { } use strict; -use Test::More; - -BEGIN { - if( !eval "require overload" ) { - plan skip_all => "needs overload.pm"; - } - else { - plan tests => 13; - } -} +use Test::More tests => 15; package Overloaded; use overload - q{""} => sub { $_[0]->{string} }, - q{0+} => sub { $_[0]->{num} }; + q{eq} => sub { $_[0]->{string} }, + q{==} => sub { $_[0]->{num} }, + q{""} => sub { $_[0]->{stringfy}++; $_[0]->{string} }, + q{0+} => sub { $_[0]->{numify}++; $_[0]->{num} } +; sub new { my $class = shift; - bless { string => shift, num => shift }, $class; + bless { + string => shift, + num => shift, + stringify => 0, + numify => 0, + }, $class; } package main; +local $SIG{__DIE__} = sub { + my($call_file, $call_line) = (caller)[1,2]; + fail("SIGDIE accidentally called"); + diag("From $call_file at $call_line"); +}; + my $obj = Overloaded->new('foo', 42); isa_ok $obj, 'Overloaded'; is $obj, 'foo', 'is() with string overloading'; cmp_ok $obj, 'eq', 'foo', 'cmp_ok() ...'; +is $obj->{stringify}, 0, 'cmp_ok() eq does not stringify'; cmp_ok $obj, '==', 42, 'cmp_ok() with number overloading'; +is $obj->{numify}, 0, 'cmp_ok() == does not numify'; is_deeply [$obj], ['foo'], 'is_deeply with string overloading'; ok eq_array([$obj], ['foo']), 'eq_array ...'; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/overload_threads.t b/gnu/usr.bin/perl/lib/Test/Simple/t/overload_threads.t index 8ba78c1d9e7..fb5e8e0cdaa 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/overload_threads.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/overload_threads.t @@ -1,4 +1,5 @@ #!perl -w +# $Id: overload_threads.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { @@ -17,16 +18,7 @@ BEGIN { eval { require threads; 'threads'->import; 1; }; } -use Test::More; - -BEGIN { - if( !eval "require overload" ) { - plan skip_all => "needs overload.pm"; - } - else { - plan tests => 5; - } -} +use Test::More tests => 5; package Overloaded; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/plan.t b/gnu/usr.bin/perl/lib/Test/Simple/t/plan.t index c2bf27a37e5..3a55521fa8c 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/plan.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/plan.t @@ -1,3 +1,6 @@ +#!/usr/bin/perl -w +# $Id$ + BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @@ -9,9 +12,11 @@ use Test::More; plan tests => 4; eval { plan tests => 4 }; -like( $@, '/^You tried to plan twice!/', 'disallow double plan' ); +is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ - 1), + 'disallow double plan' ); eval { plan 'no_plan' }; -like( $@, '/^You tried to plan twice!/', 'disallow chaning plan' ); +is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ -1), + 'disallow changing plan' ); pass('Just testing plan()'); pass('Testing it some more'); diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/plan_bad.t b/gnu/usr.bin/perl/lib/Test/Simple/t/plan_bad.t index cc1295a8f9a..efeaeeb7807 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/plan_bad.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/plan_bad.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: plan_bad.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { @@ -8,57 +9,30 @@ BEGIN { } -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; +use Test::More tests => 12; +use Test::Builder; +my $tb = Test::Builder->create; +$tb->level(0); -print "1..7\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 is ($$;$) { - my($this, $that, $name) = @_; - my $test = $this eq $that; - my $ok = ''; - $ok .= "not " unless $test; - $ok .= "ok $test_num"; - $ok .= " - $name" if defined $name; - $ok .= "\n"; - print $ok; - - unless( $test ) { - print "# got \n$this"; - print "# expected \n$that"; - } - $test_num++; - - return $test; -} +ok !eval { $tb->plan( tests => 'no_plan' ); }; +is $@, sprintf "Number of tests must be a positive integer. You gave it 'no_plan' at %s line %d.\n", $0, __LINE__ - 1; +my $foo = []; +my @foo = ($foo, 2, 3); +ok !eval { $tb->plan( tests => @foo ) }; +is $@, sprintf "Number of tests must be a positive integer. You gave it '$foo' at %s line %d.\n", $0, __LINE__ - 1; -use Test::More import => ['plan']; +ok !eval { $tb->plan( tests => 9.99 ) }; +is $@, sprintf "Number of tests must be a positive integer. You gave it '9.99' at %s line %d.\n", $0, __LINE__ - 1; -ok !eval { plan tests => 'no_plan'; }; -is $@, "Number of tests must be a postive integer. You gave it 'no_plan'.\n"; +#line 25 +ok !eval { $tb->plan( tests => -1 ) }; +is $@, "Number of tests must be a positive integer. You gave it '-1' at $0 line 25.\n"; -my $foo = []; -my @foo = ($foo, 2, 3); -ok !eval { plan tests => @foo }; -is $@, "Number of tests must be a postive integer. You gave it '$foo'.\n"; +#line 29 +ok !eval { $tb->plan( tests => '' ) }; +is $@, "You said to run 0 tests at $0 line 29.\n"; -ok !eval { plan tests => 0 }; -ok !eval { plan tests => -1 }; -ok !eval { plan tests => '' }; +#line 33 +ok !eval { $tb->plan( 'wibble' ) }; +is $@, "plan() doesn't understand wibble at $0 line 33.\n"; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/plan_is_noplan.t b/gnu/usr.bin/perl/lib/Test/Simple/t/plan_is_noplan.t index 1ab2a0e8bd9..3ac7574e52c 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/plan_is_noplan.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/plan_is_noplan.t @@ -1,3 +1,4 @@ +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @@ -11,20 +12,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/gnu/usr.bin/perl/lib/Test/Simple/t/plan_no_plan.t b/gnu/usr.bin/perl/lib/Test/Simple/t/plan_no_plan.t index b39b101cce1..fbe2408c4bb 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/plan_no_plan.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/plan_no_plan.t @@ -1,3 +1,4 @@ +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @@ -13,16 +14,28 @@ BEGIN { } } -BEGIN { - require Test::Harness; -} - -if( $Test::Harness::VERSION < 1.20 ) { - plan skip_all => 'Need Test::Harness 1.20 or up'; -} -else { - plan 'no_plan'; -} +plan 'no_plan'; pass('Just testing'); ok(1, 'Testing again'); + +{ + my $warning = ''; + local $SIG{__WARN__} = sub { $warning = join "", @_ }; + SKIP: { + skip 'Just testing skip with no_plan'; + fail("So very failed"); + } + is( $warning, '', 'skip with no "how_many" ok with no_plan' ); + + + $warning = ''; + TODO: { + todo_skip "Just testing todo_skip"; + + fail("Just testing todo"); + die "todo_skip should prevent this"; + pass("Again"); + } + is( $warning, '', 'skip with no "how_many" ok with no_plan' ); +} diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/plan_shouldnt_import.t b/gnu/usr.bin/perl/lib/Test/Simple/t/plan_shouldnt_import.t index b6eb0642446..c4aa49b2d5a 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/plan_shouldnt_import.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/plan_shouldnt_import.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: plan_shouldnt_import.t,v 1.2 2009/05/16 21:42:57 simon Exp $ # plan() used to export functions by mistake [rt.cpan.org 8385] diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/plan_skip_all.t b/gnu/usr.bin/perl/lib/Test/Simple/t/plan_skip_all.t index 528df5f50d4..13335a4927a 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/plan_skip_all.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/plan_skip_all.t @@ -1,3 +1,4 @@ +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/gnu/usr.bin/perl/lib/Test/t/pod-coverage.t b/gnu/usr.bin/perl/lib/Test/Simple/t/pod-coverage.t index 87942726e76..c95f81ac0bb 100644 --- a/gnu/usr.bin/perl/lib/Test/t/pod-coverage.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/pod-coverage.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: pod-coverage.t,v 1.1 2009/05/16 21:42:57 simon Exp $ use Test::More; diff --git a/gnu/usr.bin/perl/lib/Test/t/pod.t b/gnu/usr.bin/perl/lib/Test/Simple/t/pod.t index 3c931f94f91..ba543f14bd8 100644 --- a/gnu/usr.bin/perl/lib/Test/t/pod.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/pod.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: pod.t,v 1.1 2009/05/16 21:42:57 simon Exp $ use Test::More; eval "use Test::Pod 1.00"; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/require_ok.t b/gnu/usr.bin/perl/lib/Test/Simple/t/require_ok.t index 463a007599c..6cbfd1005c1 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/require_ok.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/require_ok.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id: require_ok.t,v 1.2 2009/05/16 21:42:57 simon Exp $ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/reset.t b/gnu/usr.bin/perl/lib/Test/Simple/t/reset.t index 320fd86a53f..253e0c47669 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/reset.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/reset.t @@ -16,6 +16,10 @@ chdir 't'; use Test::Builder; my $tb = Test::Builder->new; + +my %Original_Output; +$Original_Output{$_} = $tb->$_ for qw(output failure_output todo_output); + $tb->plan(tests => 14); $tb->level(0); @@ -66,11 +70,11 @@ 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, +ok( fileno $tb->output == fileno $Original_Output{output}, 'output' ); -ok( fileno $tb->failure_output == fileno *Test::Builder::TESTERR, +ok( fileno $tb->failure_output == fileno $Original_Output{failure_output}, 'failure_output' ); -ok( fileno $tb->todo_output == fileno *Test::Builder::TESTOUT, +ok( fileno $tb->todo_output == fileno $Original_Output{todo_output}, 'todo_output' ); ok( $tb->current_test == 0, 'current_test' ); ok( $tb->summary == 0, 'summary' ); diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/simple.t b/gnu/usr.bin/perl/lib/Test/Simple/t/simple.t index 7297e9d6dd1..67bc6f3a1bd 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/simple.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/simple.t @@ -1,3 +1,4 @@ +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/skip.t b/gnu/usr.bin/perl/lib/Test/Simple/t/skip.t index 526c5acd801..a8a7cb9b33a 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/skip.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/skip.t @@ -1,4 +1,5 @@ #!perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -7,7 +8,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 +85,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, '/^skip\(\) was passed a non-numeric number of tests/'; +} diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/skipall.t b/gnu/usr.bin/perl/lib/Test/Simple/t/skipall.t index 6f255e21ce5..1bc170b2ea9 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/skipall.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/skipall.t @@ -1,3 +1,4 @@ +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/thread_taint.t b/gnu/usr.bin/perl/lib/Test/Simple/t/thread_taint.t index d547e6d8c4e..e22e03b2e1b 100755 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/thread_taint.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/thread_taint.t @@ -1,5 +1,6 @@ #!/usr/bin/perl -w +# $Id: thread_taint.t,v 1.2 2009/05/16 21:42:57 simon Exp $ use Test::More tests => 1; -ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' );
\ No newline at end of file +ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' ); diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/threads.t b/gnu/usr.bin/perl/lib/Test/Simple/t/threads.t index 4212cccb77f..65b7bb360ee 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/threads.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/threads.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -8,13 +9,16 @@ BEGIN { } use Config; -unless ($Config{'useithreads'}) { - print "1..0 # Skip: no threads\n"; - exit 0; +BEGIN { + unless ( $] >= 5.008001 && $Config{'useithreads'} && + eval { require threads; 'threads'->import; 1; }) + { + print "1..0 # Skip: no working threads\n"; + exit 0; + } } use strict; -require threads; use Test::Builder; my $Test = Test::Builder->new; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/todo.t b/gnu/usr.bin/perl/lib/Test/Simple/t/todo.t index 31ceb5f6345..259a6616081 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/todo.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/todo.t @@ -1,4 +1,5 @@ #!perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -7,29 +8,25 @@ BEGIN { } } -BEGIN { - require Test::Harness; - use Test::More; +use Test::More; + +plan tests => 36; - if( $Test::Harness::VERSION < 1.23 ) { - plan skip_all => 'Need Test::Harness 1.23 or up'; - } - else { - plan tests => 15; - } -} $Why = 'Just testing the todo interface.'; +my $is_todo; TODO: { local $TODO = $Why; fail("Expected failure"); fail("Another expected failure"); -} + $is_todo = Test::More->builder->todo; +} pass("This is not todo"); +ok( $is_todo, 'TB->todo' ); TODO: { @@ -64,3 +61,98 @@ TODO: { die "todo_skip should prevent this"; pass("Again"); } + + +{ + my $warning; + local $SIG{__WARN__} = sub { $warning = join "", @_ }; + TODO: { + # perl gets the line number a little wrong on the first + # statement inside a block. + 1 == 1; +#line 74 + todo_skip "Just testing todo_skip"; + fail("So very failed"); + } + is( $warning, "todo_skip() needs to know \$how_many tests are in the ". + "block at $0 line 74\n", + 'todo_skip without $how_many warning' ); +} + +my $builder = Test::More->builder; +my $exported_to = $builder->exported_to; +TODO: { + $builder->exported_to("Wibble"); + + local $TODO = "testing \$TODO with an incorrect exported_to()"; + + fail("Just testing todo"); +} + +$builder->exported_to($exported_to); + +$builder->todo_start('Expected failures'); +fail('Testing todo_start()'); +ok 0, 'Testing todo_start() with more than one failure'; +$is_todo = $builder->todo; +$builder->todo_end; +is $is_todo, 'Expected failures', + 'todo_start should have the correct TODO message'; +ok 1, 'todo_end() should not leak TODO behavior'; + +my @nested_todo; +my ( $level1, $level2 ) = ( 'failure level 1', 'failure_level 2' ); +TODO: { + local $TODO = 'Nesting TODO'; + fail('fail 1'); + + $builder->todo_start($level1); + fail('fail 2'); + + push @nested_todo => $builder->todo; + $builder->todo_start($level2); + fail('fail 3'); + + push @nested_todo => $builder->todo; + $builder->todo_end; + fail('fail 4'); + + push @nested_todo => $builder->todo; + $builder->todo_end; + $is_todo = $builder->todo; + fail('fail 4'); +} +is_deeply \@nested_todo, [ $level1, $level2, $level1 ], + 'Nested TODO message should be correct'; +is $is_todo, 'Nesting TODO', + '... and original TODO message should be correct'; + +{ + $builder->todo_start; + fail("testing todo_start() with no message"); + my $reason = $builder->todo; + my $in_todo = $builder->in_todo; + $builder->todo_end; + + is $reason, '', " todo() reports no reason"; + ok $in_todo, " but we're in_todo()"; +} + +eval { + $builder->todo_end; +}; +is $@, sprintf "todo_end() called without todo_start() at %s line %d.\n", $0, __LINE__ - 2; + + +{ + my($reason, $in_todo); + + TODO: { + local $TODO = ''; + $reason = $builder->todo; + $in_todo = $builder->in_todo; + } + + is $reason, ''; + ok !$in_todo, '$TODO = "" is not considered TODO'; +} diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/undef.t b/gnu/usr.bin/perl/lib/Test/Simple/t/undef.t index 00ce8b19370..b7f1f2cd90b 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/undef.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/undef.t @@ -1,4 +1,5 @@ #!/usr/bin/perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -11,7 +12,7 @@ BEGIN { } use strict; -use Test::More tests => 14; +use Test::More tests => 20; use TieOut; BEGIN { $^W = 1; } @@ -19,32 +20,62 @@ BEGIN { $^W = 1; } my $warnings = ''; local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; +my $TB = Test::Builder->new; +sub no_warnings { + $TB->is_eq($warnings, '', ' no warnings'); + $warnings = ''; +} + +sub warnings_is { + $TB->is_eq($warnings, $_[0]); + $warnings = ''; +} + +sub warnings_like { + $TB->like($warnings, $_[0]); + $warnings = ''; +} + + +my $Filename = quotemeta $0; + + is( undef, undef, 'undef is undef'); -is( $warnings, '', ' no warnings' ); +no_warnings; isnt( undef, 'foo', 'undef isnt foo'); -is( $warnings, '', ' no warnings' ); +no_warnings; isnt( undef, '', 'undef isnt an empty string' ); isnt( undef, 0, 'undef isnt zero' ); +Test::More->builder->is_num(undef, undef, 'is_num()'); +Test::More->builder->isnt_num(23, undef, 'isnt_num()'); + +#line 45 like( undef, '/.*/', 'undef is like anything' ); -is( $warnings, '', ' no warnings' ); +warnings_like(qr/Use of uninitialized value.* at $Filename line 45\.\n/); eq_array( [undef, undef], [undef, 23] ); -is( $warnings, '', 'eq_array() no warnings' ); +no_warnings; eq_hash ( { foo => undef, bar => undef }, { foo => undef, bar => 23 } ); -is( $warnings, '', 'eq_hash() no warnings' ); +no_warnings; eq_set ( [undef, undef, 12], [29, undef, undef] ); -is( $warnings, '', 'eq_set() no warnings' ); +no_warnings; eq_hash ( { foo => undef, bar => { baz => undef, moo => 23 } }, { foo => undef, bar => { baz => undef, moo => 23 } } ); -is( $warnings, '', 'eq_hash() no warnings' ); +no_warnings; + + +#line 64 +cmp_ok( undef, '<=', 2, ' undef <= 2' ); +warnings_like(qr/Use of uninitialized value.* at cmp_ok \[from $Filename line 64\] line 1\.\n/); + my $tb = Test::More->builder; @@ -57,4 +88,9 @@ diag(undef); $tb->failure_output($old_fail); is( $caught->read, "# undef\n" ); -is( $warnings, '', 'diag(undef) no warnings' ); +no_warnings; + + +$tb->maybe_regex(undef); +is( $caught->read, '' ); +no_warnings; diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/use_ok.t b/gnu/usr.bin/perl/lib/Test/Simple/t/use_ok.t index e944628176c..a53fe25fe49 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/use_ok.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/use_ok.t @@ -1,13 +1,17 @@ #!/usr/bin/perl -w +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = '../lib'; + @INC = qw(../lib ../lib/Test/Simple/t/lib); + } + else { + unshift @INC, 't/lib'; } } -use Test::More tests => 10; +use Test::More tests => 15; # Using Symbol because it's core and exports lots of stuff. { @@ -36,3 +40,29 @@ 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); +} + +{ + package Foo::eight; + local $SIG{__DIE__}; + ::use_ok("SigDie"); + ::ok(defined $SIG{__DIE__}, ' SIG{__DIE__} preserved'); +} diff --git a/gnu/usr.bin/perl/lib/Test/Simple/t/useing.t b/gnu/usr.bin/perl/lib/Test/Simple/t/useing.t index c4ce5071270..19dde01b262 100644 --- a/gnu/usr.bin/perl/lib/Test/Simple/t/useing.t +++ b/gnu/usr.bin/perl/lib/Test/Simple/t/useing.t @@ -1,3 +1,4 @@ +# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/gnu/usr.bin/perl/lib/Test/t/00test_harness_check.t b/gnu/usr.bin/perl/lib/Test/t/00test_harness_check.t deleted file mode 100644 index 3ff4a13c639..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/00test_harness_check.t +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/perl -w - -# A test to make sure the new Test::Harness was installed properly. - -use Test::More; -plan tests => 1; - -my $TH_Version = 2.03; - -require Test::Harness; -unless( cmp_ok( eval $Test::Harness::VERSION, '>=', $TH_Version, "T::H version" ) ) { - diag <<INSTRUCTIONS; - -Test::Simple/More/Builder has features which depend on a version of -Test::Harness greater than $TH_Version. 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/gnu/usr.bin/perl/lib/Test/t/BEGIN_require_ok.t b/gnu/usr.bin/perl/lib/Test/t/BEGIN_require_ok.t deleted file mode 100644 index 289ebc564f3..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/BEGIN_require_ok.t +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More; - -my $result; -BEGIN { - eval { - require_ok("Wibble"); - }; - $result = $@; -} - -plan tests => 1; -like $result, '/^You tried to run a test without a plan/'; diff --git a/gnu/usr.bin/perl/lib/Test/t/BEGIN_use_ok.t b/gnu/usr.bin/perl/lib/Test/t/BEGIN_use_ok.t deleted file mode 100644 index 26caaa127e6..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/BEGIN_use_ok.t +++ /dev/null @@ -1,28 +0,0 @@ -#!/usr/bin/perl -w - -# [rt.cpan.org 28345] -# -# A use_ok() inside a BEGIN block lacking a plan would be silently ignored. - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More; - -my $result; -BEGIN { - eval { - use_ok("Wibble"); - }; - $result = $@; -} - -plan tests => 1; -like $result, '/^You tried to run a test without a plan/'; diff --git a/gnu/usr.bin/perl/lib/Test/t/More.t b/gnu/usr.bin/perl/lib/Test/t/More.t deleted file mode 100644 index eabd0fa8a42..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/More.t +++ /dev/null @@ -1,174 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = qw(../lib ../lib/Test/Simple/t/lib); - } -} - -use lib 't/lib'; -use Test::More tests => 52; - -# Make sure we don't mess with $@ or $!. Test at bottom. -my $Err = "this should not be touched"; -my $Errno = 42; -$@ = $Err; -$! = $Errno; - -use_ok('Dummy'); -is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' ); -require_ok('Test::More'); - - -ok( 2 eq 2, 'two is two is two is two' ); -is( "foo", "foo", 'foo is foo' ); -isnt( "foo", "bar", 'foo isnt bar'); -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' ); - -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 - can_ok pass fail eq_array eq_hash eq_set)); - - -isa_ok(bless([], "Foo"), "Foo"); -isa_ok([], 'ARRAY'); -isa_ok(\42, 'SCALAR'); - - -# can_ok() & isa_ok should call can() & isa() on the given object, not -# just class, in case of custom can() -{ - local *Foo::can; - local *Foo::isa; - *Foo::can = sub { $_[0]->[0] }; - *Foo::isa = sub { $_[0]->[0] }; - my $foo = bless([0], 'Foo'); - ok( ! $foo->can('bar') ); - ok( ! $foo->isa('bar') ); - $foo->[0] = 1; - can_ok( $foo, 'blah'); - isa_ok( $foo, 'blah'); -} - - -pass('pass() passed'); - -ok( eq_array([qw(this that whatever)], [qw(this that whatever)]), - 'eq_array with simple arrays' ); -is @Test::More::Data_Stack, 0, '@Data_Stack not holding onto things'; - -ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}), - 'eq_hash with simple hashes' ); -is @Test::More::Data_Stack, 0; - -ok( eq_set([qw(this that whatever)], [qw(that whatever this)]), - 'eq_set with simple sets' ); -is @Test::More::Data_Stack, 0; - -my @complex_array1 = ( - [qw(this that whatever)], - {foo => 23, bar => 42}, - "moo", - "yarrow", - [qw(498 10 29)], - ); -my @complex_array2 = ( - [qw(this that whatever)], - {foo => 23, bar => 42}, - "moo", - "yarrow", - [qw(498 10 29)], - ); - -is_deeply( \@complex_array1, \@complex_array2, 'is_deeply with arrays' ); -ok( eq_array(\@complex_array1, \@complex_array2), - 'eq_array with complicated arrays' ); -ok( eq_set(\@complex_array1, \@complex_array2), - 'eq_set with complicated arrays' ); - -my @array1 = (qw(this that whatever), - {foo => 23, bar => 42} ); -my @array2 = (qw(this that whatever), - {foo => 24, bar => 42} ); - -ok( !eq_array(\@array1, \@array2), - 'eq_array with slightly different complicated arrays' ); -is @Test::More::Data_Stack, 0; - -ok( !eq_set(\@array1, \@array2), - 'eq_set with slightly different complicated arrays' ); -is @Test::More::Data_Stack, 0; - -my %hash1 = ( foo => 23, - bar => [qw(this that whatever)], - har => { foo => 24, bar => 42 }, - ); -my %hash2 = ( foo => 23, - bar => [qw(this that whatever)], - har => { foo => 24, bar => 42 }, - ); - -is_deeply( \%hash1, \%hash2, 'is_deeply with complicated hashes' ); -ok( eq_hash(\%hash1, \%hash2), 'eq_hash with complicated hashes'); - -%hash1 = ( foo => 23, - bar => [qw(this that whatever)], - har => { foo => 24, bar => 42 }, - ); -%hash2 = ( foo => 23, - bar => [qw(this tha whatever)], - har => { foo => 24, bar => 42 }, - ); - -ok( !eq_hash(\%hash1, \%hash2), - 'eq_hash with slightly different complicated hashes' ); -is @Test::More::Data_Stack, 0; - -is( Test::Builder->new, Test::More->builder, 'builder()' ); - - -cmp_ok(42, '==', 42, 'cmp_ok =='); -cmp_ok('foo', 'eq', 'foo', ' eq'); -cmp_ok(42.5, '<', 42.6, ' <'); -cmp_ok(0, '||', 1, ' ||'); - - -# Piers pointed out sometimes people override isa(). -{ - package Wibble; - sub isa { - my($self, $class) = @_; - return 1 if $class eq 'Wibblemeister'; - } - sub new { bless {} } -} -isa_ok( Wibble->new, 'Wibblemeister' ); - -my $sub = sub {}; -is_deeply( $sub, $sub, 'the same function ref' ); - -use Symbol; -my $glob = gensym; -is_deeply( $glob, $glob, 'the same glob' ); - -is_deeply( { foo => $sub, bar => [1, $glob] }, - { foo => $sub, bar => [1, $glob] } - ); - -# These two tests must remain at the end. -is( $@, $Err, '$@ untouched' ); -cmp_ok( $!, '==', $Errno, '$! untouched' ); diff --git a/gnu/usr.bin/perl/lib/Test/t/bad_plan.t b/gnu/usr.bin/perl/lib/Test/t/bad_plan.t deleted file mode 100644 index 442fee86f09..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/bad_plan.t +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -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; -} - - -use Test::Builder; -my $Test = Test::Builder->new; - -print "1..2\n"; - -eval { $Test->plan(7); }; -ok( $@ =~ /^plan\(\) doesn't understand 7/, 'bad plan()' ) || - print STDERR "# $@"; - -eval { $Test->plan(wibble => 7); }; -ok( $@ =~ /^plan\(\) doesn't understand wibble 7/, 'bad plan()' ) || - print STDERR "# $@"; - diff --git a/gnu/usr.bin/perl/lib/Test/t/bail_out.t b/gnu/usr.bin/perl/lib/Test/t/bail_out.t deleted file mode 100644 index d60c1509a4e..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/bail_out.t +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -my $Exit_Code; -BEGIN { - *CORE::GLOBAL::exit = sub { $Exit_Code = shift; }; -} - - -use Test::Builder; -use Test::More; -use TieOut; - -my $output = tie *FAKEOUT, 'TieOut'; -my $TB = Test::More->builder; -$TB->output(\*FAKEOUT); - -my $Test = Test::Builder->create; -$Test->level(0); - -if( $] >= 5.005 ) { - $Test->plan(tests => 3); -} -else { - $Test->plan(skip_all => - 'CORE::GLOBAL::exit, introduced in 5.005, is needed for testing'); -} - - -plan tests => 4; - -BAIL_OUT("ROCKS FALL! EVERYONE DIES!"); - - -$Test->is_eq( $output->read, <<'OUT' ); -1..4 -Bail out! ROCKS FALL! EVERYONE DIES! -OUT - -$Test->is_eq( $Exit_Code, 255 ); - -$Test->ok( $Test->can("BAILOUT"), "Backwards compat" ); diff --git a/gnu/usr.bin/perl/lib/Test/t/buffer.t b/gnu/usr.bin/perl/lib/Test/t/buffer.t deleted file mode 100644 index 6039e4a6f72..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/buffer.t +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -# Ensure that intermixed prints to STDOUT and tests come out in the -# right order (ie. no buffering problems). - -use Test::More tests => 20; -my $T = Test::Builder->new; -$T->no_ending(1); - -for my $num (1..10) { - $tnum = $num * 2; - pass("I'm ok"); - $T->current_test($tnum); - print "ok $tnum - You're ok\n"; -} diff --git a/gnu/usr.bin/perl/lib/Test/t/c_flag.t b/gnu/usr.bin/perl/lib/Test/t/c_flag.t deleted file mode 100644 index a33963415ed..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/c_flag.t +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl -w - -# Test::More should not print anything when Perl is only doing -# a compile as with the -c flag or B::Deparse or perlcc. - -# HARNESS_ACTIVE=1 was causing an error with -c -{ - local $ENV{HARNESS_ACTIVE} = 1; - local $^C = 1; - - require Test::More; - Test::More->import(tests => 1); - - fail("This should not show up"); -} - -Test::More->builder->no_ending(1); - -print "1..1\n"; -print "ok 1\n"; - diff --git a/gnu/usr.bin/perl/lib/Test/t/circular_data.t b/gnu/usr.bin/perl/lib/Test/t/circular_data.t deleted file mode 100644 index 2fd819e1f4a..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/circular_data.t +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/perl -w - -# Test is_deeply and friends with circular data structures [rt.cpan.org 7289] - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 11; - -my $a1 = [ 1, 2, 3 ]; -push @$a1, $a1; -my $a2 = [ 1, 2, 3 ]; -push @$a2, $a2; - -is_deeply $a1, $a2; -ok( eq_array ($a1, $a2) ); -ok( eq_set ($a1, $a2) ); - -my $h1 = { 1=>1, 2=>2, 3=>3 }; -$h1->{4} = $h1; -my $h2 = { 1=>1, 2=>2, 3=>3 }; -$h2->{4} = $h2; - -is_deeply $h1, $h2; -ok( eq_hash ($h1, $h2) ); - -my ($r, $s); - -$r = \$r; -$s = \$s; - -ok( eq_array ([$s], [$r]) ); - - -{ - # Classic set of circular scalar refs. - my($a,$b,$c); - $a = \$b; - $b = \$c; - $c = \$a; - - my($d,$e,$f); - $d = \$e; - $e = \$f; - $f = \$d; - - is_deeply( $a, $a ); - is_deeply( $a, $d ); -} - - -{ - # rt.cpan.org 11623 - # Make sure the circular ref checks don't get confused by a reference - # which is simply repeating. - my $a = {}; - my $b = {}; - my $c = {}; - - is_deeply( [$a, $a], [$b, $c] ); - is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } ); - is_deeply( [\$a, \$a], [\$b, \$c] ); -} diff --git a/gnu/usr.bin/perl/lib/Test/t/cmp_ok.t b/gnu/usr.bin/perl/lib/Test/t/cmp_ok.t deleted file mode 100644 index 5741fa0f82d..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/cmp_ok.t +++ /dev/null @@ -1,75 +0,0 @@ -#!/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; - -require Test::Builder; -my $TB = Test::Builder->create; -$TB->level(0); - -sub try_cmp_ok { - my($left, $cmp, $right) = @_; - - my %expect; - $expect{ok} = eval "\$left $cmp \$right"; - $expect{error} = $@; - $expect{error} =~ s/ at .*\n?//; - - local $Test::Builder::Level = $Test::Builder::Level + 1; - my $ok = cmp_ok($left, $cmp, $right, "cmp_ok"); - $TB->is_num(!!$ok, !!$expect{ok}, " right return"); - - my $diag = $err->read; - if( !$ok and $expect{error} ) { - $diag =~ s/^# //mg; - $TB->like( $diag, qr/\Q$expect{error}\E/, " expected error" ); - } - elsif( $ok ) { - $TB->is_eq( $diag, '', " passed without diagnostic" ); - } - else { - $TB->ok(1, " failed without diagnostic"); - } -} - - -use Test::More; -Test::More->builder->no_ending(1); - -require MyOverload; -my $cmp = Overloaded::Compare->new("foo", 42); -my $ify = Overloaded::Ify->new("bar", 23); - -my @Tests = ( - [1, '==', 1], - [1, '==', 2], - ["a", "eq", "b"], - ["a", "eq", "a"], - [1, "+", 1], - [1, "-", 1], - - [$cmp, '==', 42], - [$cmp, 'eq', "foo"], - [$ify, 'eq', "bar"], - [$ify, "==", 23], -); - -plan tests => scalar @Tests; -$TB->plan(tests => @Tests * 2); - -for my $test (@Tests) { - try_cmp_ok(@$test); -} diff --git a/gnu/usr.bin/perl/lib/Test/t/diag.t b/gnu/usr.bin/perl/lib/Test/t/diag.t deleted file mode 100644 index 912725199ec..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/diag.t +++ /dev/null @@ -1,89 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - - -# Turn on threads here, if available, since this test tends to find -# lots of threading bugs. -use Config; -BEGIN { - if( $] >= 5.008001 && $Config{useithreads} ) { - require threads; - 'threads'->import; - } -} - - -use strict; - -use Test::More tests => 7; - -my $test = Test::Builder->create; - -# now make a filehandle where we can send data -use TieOut; -my $output = tie *FAKEOUT, 'TieOut'; - - -# Test diag() goes to todo_output() in a todo test. -{ - $test->todo_start(); - $test->todo_output(\*FAKEOUT); - - $test->diag("a single line"); - is( $output->read, <<'DIAG', 'diag() with todo_output set' ); -# a single line -DIAG - - my $ret = $test->diag("multiple\n", "lines"); - is( $output->read, <<'DIAG', ' multi line' ); -# multiple -# lines -DIAG - ok( !$ret, 'diag returns false' ); - - $test->todo_end(); -} - -$test->reset_outputs(); - - -# Test diagnostic formatting -$test->failure_output(\*FAKEOUT); -{ - $test->diag("# foo"); - is( $output->read, "# # foo\n", "diag() adds # even if there's one already" ); - - $test->diag("foo\n\nbar"); - is( $output->read, <<'DIAG', " blank lines get escaped" ); -# foo -# -# bar -DIAG - - - $test->diag("foo\n\nbar\n\n"); - is( $output->read, <<'DIAG', " even at the end" ); -# foo -# -# bar -# -DIAG -} - - -# [rt.cpan.org 8392] -{ - $test->diag(qw(one two)); -} -is( $output->read, <<'DIAG' ); -# onetwo -DIAG diff --git a/gnu/usr.bin/perl/lib/Test/t/died.t b/gnu/usr.bin/perl/lib/Test/t/died.t deleted file mode 100644 index b4ee2fbbffd..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/died.t +++ /dev/null @@ -1,45 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 3); - - -package main; - -require Test::Simple; - -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 => 1); -exit 250; - -END { - $TB->is_eq($out->read, <<OUT); -1..1 -OUT - - $TB->is_eq($err->read, <<ERR); -# Looks like your test exited with 250 before it could output anything. -ERR - - $TB->is_eq($?, 250, "exit code"); - - exit grep { !$_ } $TB->summary; -} diff --git a/gnu/usr.bin/perl/lib/Test/t/dont_overwrite_die_handler.t b/gnu/usr.bin/perl/lib/Test/t/dont_overwrite_die_handler.t deleted file mode 100644 index 0657a06ca33..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/dont_overwrite_die_handler.t +++ /dev/null @@ -1,19 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -# Make sure this is in place before Test::More is loaded. -my $handler_called; -BEGIN { - $SIG{__DIE__} = sub { $handler_called++ }; -} - -use Test::More tests => 2; - -ok !eval { die }; -is $handler_called, 1, 'existing DIE handler not overridden'; diff --git a/gnu/usr.bin/perl/lib/Test/t/eq_set.t b/gnu/usr.bin/perl/lib/Test/t/eq_set.t deleted file mode 100644 index fbdc52db1fa..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/eq_set.t +++ /dev/null @@ -1,34 +0,0 @@ -#!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 => 4; - -# RT 3747 -ok( eq_set([1, 2, [3]], [[3], 1, 2]) ); -ok( eq_set([1,2,[3]], [1,[3],2]) ); - -# bugs.perl.org 36354 -my $ref = \2; -ok( eq_set( [$ref, "$ref", "$ref", $ref], - ["$ref", $ref, $ref, "$ref"] - ) ); - -TODO: { - local $TODO = q[eq_set() doesn't really handle references]; - - ok( eq_set( [\1, \2, \3], [\2, \3, \1] ) ); -} - diff --git a/gnu/usr.bin/perl/lib/Test/t/exit.t b/gnu/usr.bin/perl/lib/Test/t/exit.t deleted file mode 100644 index d20452ed043..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/exit.t +++ /dev/null @@ -1,97 +0,0 @@ -#!/usr/bin/perl -w - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -unless( eval { require File::Spec } ) { - print "1..0 # Skip Need File::Spec to run this test\n"; - exit 0; -} - -if( $^O eq 'VMS' && $] <= 5.00503 ) { - print "1..0 # Skip test will hang on older VMS perls\n"; - exit 0; -} - -if( $^O eq 'MacOS' ) { - print "1..0 # Skip exit status broken on Mac OS\n"; - exit 0; -} - -require Test::Builder; -my $TB = Test::Builder->create(); -$TB->level(0); - - -package main; - -my $IsVMS = $^O eq 'VMS'; - -print "# Ahh! I see you're running VMS.\n" if $IsVMS; - -my %Tests = ( - # Everyone Else VMS - 'success.plx' => [0, 0], - 'one_fail.plx' => [1, 4], - 'two_fail.plx' => [2, 4], - 'five_fail.plx' => [5, 4], - 'extras.plx' => [2, 4], - 'too_few.plx' => [255, 4], - 'too_few_fail.plx' => [2, 4], - 'death.plx' => [255, 4], - 'last_minute_death.plx' => [255, 4], - 'pre_plan_death.plx' => ['not zero', 'not zero'], - 'death_in_eval.plx' => [0, 0], - 'require.plx' => [0, 0], - 'death_with_handler.plx' => [255, 4], - 'exit.plx' => [1, 4], - ); - -$TB->plan( tests => scalar keys(%Tests) ); - -eval { require POSIX; &POSIX::WEXITSTATUS(0) }; -if( $@ ) { - *exitstatus = sub { $_[0] >> 8 }; -} -else { - *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) } -} - -my $Perl = File::Spec->rel2abs($^X); - -chdir 't'; -my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests)); -while( my($test_name, $exit_codes) = each %Tests ) { - my($exit_code) = $exit_codes->[$IsVMS ? 1 : 0]; - - if( $^O eq 'VMS' ) { - # VMS can't use its own $^X in a system call until almost 5.8 - $Perl = "MCR $^X" if $] < 5.007003; - - # Quiet noisy 'SYS$ABORT'. 'hushed' only exists in 5.6 and up, - # but it doesn't do any harm on eariler perls. - $Perl .= q{ -"Mvmsish=hushed"}; - } - - my $file = File::Spec->catfile($lib, $test_name); - my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file}); - my $actual_exit = exitstatus($wait_stat); - - if( $exit_code eq 'not zero' ) { - $TB->isnt_num( $actual_exit, 0, - "$test_name exited with $actual_exit ". - "(expected $exit_code)"); - } - else { - $TB->is_num( $actual_exit, $exit_code, - "$test_name exited with $actual_exit ". - "(expected $exit_code)"); - } -} diff --git a/gnu/usr.bin/perl/lib/Test/t/explain.t b/gnu/usr.bin/perl/lib/Test/t/explain.t deleted file mode 100644 index cf2f550e950..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/explain.t +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use warnings; - -use Test::More tests => 5; - -can_ok "main", "explain"; - -is_deeply [explain("foo")], ["foo"]; -is_deeply [explain("foo", "bar")], ["foo", "bar"]; - -# Avoid future dump formatting changes from breaking tests by just eval'ing -# the dump -is_deeply [map { eval $_ } explain([], {})], [[], {}]; - -is_deeply [map { eval $_ } explain(23, [42,91], 99)], [23, [42, 91], 99]; diff --git a/gnu/usr.bin/perl/lib/Test/t/extra.t b/gnu/usr.bin/perl/lib/Test/t/extra.t deleted file mode 100644 index 57235be1956..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/extra.t +++ /dev/null @@ -1,59 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 2); - - -package main; - -require Test::Simple; - -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); - -#line 30 -ok(1, 'Foo'); -ok(0, 'Bar'); -ok(1, 'Yar'); -ok(1, 'Car'); -ok(0, 'Sar'); - -END { - $TB->is_eq($$out, <<OUT); -1..3 -ok 1 - Foo -not ok 2 - Bar -ok 3 - Yar -ok 4 - Car -not ok 5 - Sar -OUT - - $TB->is_eq($$err, <<ERR); -# Failed test 'Bar' -# at $0 line 31. -# Failed test 'Sar' -# at $0 line 34. -# Looks like you planned 3 tests but ran 5. -# Looks like you failed 2 tests of 5 run. -ERR - - exit 0; -} diff --git a/gnu/usr.bin/perl/lib/Test/t/extra_one.t b/gnu/usr.bin/perl/lib/Test/t/extra_one.t deleted file mode 100644 index d77404e15de..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/extra_one.t +++ /dev/null @@ -1,52 +0,0 @@ -#!/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; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 2); - -sub is { $TB->is_eq(@_) } - - -package main; - -require Test::Simple; -Test::Simple->import(tests => 1); -ok(1); -ok(1); -ok(1); - -END { - My::Test::is($$out, <<OUT); -1..1 -ok 1 -ok 2 -ok 3 -OUT - - My::Test::is($$err, <<ERR); -# Looks like you planned 1 test but ran 3. -ERR - - # Prevent Test::Simple from existing with non-zero - exit 0; -} diff --git a/gnu/usr.bin/perl/lib/Test/t/fail-like.t b/gnu/usr.bin/perl/lib/Test/t/fail-like.t deleted file mode 100644 index a0ee7305893..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/fail-like.t +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -# There was a bug with like() involving a qr// not failing properly. -# This tests against that. - -use strict; - - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 4); - - -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); -local $ENV{HARNESS_ACTIVE} = 0; - - -package main; - -require Test::More; -Test::More->import(tests => 1); - -{ - eval q{ like( "foo", qr/that/, 'is foo like that' ); }; - - $TB->is_eq($out->read, <<OUT, 'failing output'); -1..1 -not ok 1 - is foo like that -OUT - - my $err_re = <<ERR; -# Failed test 'is foo like that' -# at .* line 1\. -# 'foo' -# doesn't match '\\(\\?-xism:that\\)' -ERR - - $TB->like($err->read, qr/^$err_re$/, 'failing errors'); -} - -{ - # line 60 - like("foo", "not a regex"); - $TB->is_eq($out->read, <<OUT); -not ok 2 -OUT - - $TB->is_eq($err->read, <<OUT); -# Failed test at $0 line 60. -# 'not a regex' doesn't look much like a regex to me. -OUT - -} - -END { - # Test::More thinks it failed. Override that. - exit(scalar grep { !$_ } $TB->summary); -} diff --git a/gnu/usr.bin/perl/lib/Test/t/fail-more.t b/gnu/usr.bin/perl/lib/Test/t/fail-more.t deleted file mode 100644 index 3af7456a1be..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/fail-more.t +++ /dev/null @@ -1,388 +0,0 @@ -#!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; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 23); - -sub like ($$;$) { - $TB->like(@_); -} - -sub is ($$;$) { - $TB->is_eq(@_); -} - -sub main::err_ok ($) { - my($expect) = @_; - my $got = $err->read; - - return $TB->is_eq( $got, $expect ); -} - -sub main::err_like ($) { - my($expect) = @_; - my $got = $err->read; - - return $TB->like( $got, qr/$expect/ ); -} - - -package main; - -require Test::More; -my $Total = 36; -Test::More->import(tests => $Total); - -# This should all work in the presence of a __DIE__ handler. -local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); }; - - -my $tb = Test::More->builder; -$tb->use_numbers(0); - -my $Filename = quotemeta $0; - -# Preserve the line numbers. -#line 38 -ok( 0, 'failing' ); -err_ok( <<ERR ); -# Failed test 'failing' -# at $0 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?' ); -err_ok( <<ERR ); -# Failed test 'foo is bar?' -# at $0 line 40. -# got: 'foo' -# expected: 'bar' -# Failed test 'undef is empty string?' -# at $0 line 41. -# got: undef -# expected: '' -# Failed test 'undef is 0?' -# at $0 line 42. -# got: undef -# expected: '0' -# Failed test 'empty string is 0?' -# at $0 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_ok( <<ERR ); -# Failed test 'foo isnt foo?' -# at $0 line 45. -# got: 'foo' -# expected: anything else -# Failed test 'foo isn\'t foo?' -# at $0 line 46. -# got: 'foo' -# expected: anything else -# Failed test 'undef isnt undef?' -# at $0 line 47. -# got: undef -# expected: anything else -ERR - -#line 48 -like( "foo", '/that/', 'is foo like that' ); -unlike( "foo", '/foo/', 'is foo unlike foo' ); -err_ok( <<ERR ); -# Failed test 'is foo like that' -# at $0 line 48. -# 'foo' -# doesn't match '/that/' -# Failed test 'is foo unlike foo' -# at $0 line 49. -# 'foo' -# matches '/foo/' -ERR - -# Nick Clark found this was a bug. Fixed in 0.40. -# line 60 -like( "bug", '/(%)/', 'regex with % in it' ); -err_ok( <<ERR ); -# Failed test 'regex with % in it' -# at $0 line 60. -# 'bug' -# doesn't match '/(%)/' -ERR - -#line 67 -fail('fail()'); -err_ok( <<ERR ); -# Failed test 'fail()' -# at $0 line 67. -ERR - -#line 52 -can_ok('Mooble::Hooble::Yooble', qw(this that)); -can_ok('Mooble::Hooble::Yooble', ()); -can_ok(undef, undef); -can_ok([], "foo"); -err_ok( <<ERR ); -# Failed test 'Mooble::Hooble::Yooble->can(...)' -# at $0 line 52. -# Mooble::Hooble::Yooble->can('this') failed -# Mooble::Hooble::Yooble->can('that') failed -# Failed test 'Mooble::Hooble::Yooble->can(...)' -# at $0 line 53. -# can_ok() called with no methods -# Failed test '->can(...)' -# at $0 line 54. -# can_ok() called with empty class or reference -# Failed test 'ARRAY->can('foo')' -# at $0 line 55. -# ARRAY->can('foo') failed -ERR - -#line 55 -isa_ok(bless([], "Foo"), "Wibble"); -isa_ok(42, "Wibble", "My Wibble"); -isa_ok(undef, "Wibble", "Another Wibble"); -isa_ok([], "HASH"); -err_ok( <<ERR ); -# Failed test 'The object isa Wibble' -# at $0 line 55. -# The object isn't a 'Wibble' it's a 'Foo' -# Failed test 'My Wibble isa Wibble' -# at $0 line 56. -# My Wibble isn't a reference -# Failed test 'Another Wibble isa Wibble' -# at $0 line 57. -# Another Wibble isn't defined -# Failed test 'The object isa HASH' -# at $0 line 58. -# The object isn't a 'HASH' it's a 'ARRAY' -ERR - - -#line 188 -new_ok(undef); -err_like( <<ERR ); -# Failed test 'new\\(\\) died' -# at $Filename line 188. -# Error was: Can't call method "new" on an undefined value at .* -ERR - -#line 211 -new_ok( "Does::Not::Exist" ); -err_like( <<ERR ); -# Failed test 'new\\(\\) died' -# at $Filename line 211. -# Error was: Can't locate object method "new" via package "Does::Not::Exist" .* -ERR - -{ package Foo; sub new { } } -{ package Bar; sub new { {} } } -{ package Baz; sub new { bless {}, "Wibble" } } - -#line 219 -new_ok( "Foo" ); -err_ok( <<ERR ); -# Failed test 'The object isa Foo' -# at $0 line 219. -# The object isn't defined -ERR - -# line 231 -new_ok( "Bar" ); -err_ok( <<ERR ); -# Failed test 'The object isa Bar' -# at $0 line 231. -# The object isn't a 'Bar' it's a 'HASH' -ERR - -#line 239 -new_ok( "Baz" ); -err_ok( <<ERR ); -# Failed test 'The object isa Baz' -# at $0 line 239. -# The object isn't a 'Baz' it's a 'Wibble' -ERR - -#line 247 -new_ok( "Baz", [], "no args" ); -err_ok( <<ERR ); -# Failed test 'no args isa Baz' -# at $0 line 247. -# no args isn't a 'Baz' it's a 'Wibble' -ERR - - -#line 68 -cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' ); -cmp_ok( 42.1, '==', 23, , ' ==' ); -cmp_ok( 42, '!=', 42 , ' !=' ); -cmp_ok( 1, '&&', 0 , ' &&' ); -err_ok( <<ERR ); -# Failed test 'cmp_ok eq' -# at $0 line 68. -# got: 'foo' -# expected: 'bar' -# Failed test ' ==' -# at $0 line 69. -# got: 42.1 -# expected: 23 -# Failed test ' !=' -# at $0 line 70. -# got: 42 -# expected: anything else -# Failed test ' &&' -# at $0 line 71. -# '1' -# && -# '0' -ERR - - -# line 196 -cmp_ok( 42, 'eq', "foo", ' eq with numbers' ); -err_ok( <<ERR ); -# Failed test ' eq with numbers' -# at $0 line 196. -# got: '42' -# expected: 'foo' -ERR - - -{ - my $warnings; - local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; - -# line 211 - cmp_ok( 42, '==', "foo", ' == with strings' ); - err_ok( <<ERR ); -# Failed test ' == with strings' -# at $0 line 211. -# got: 42 -# expected: foo -ERR - My::Test::like $warnings, - qr/^Argument "foo" isn't numeric in .* at cmp_ok \[from $Filename line 211\] line 1\.\n$/; - -} - - -# 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_ok( <<ERR ); -# Failed test ' eq with stringified errno' -# at $0 line 80. -# got: '$Errno_String' -# expected: '' -# Failed test ' eq with numerified errno' -# at $0 line 81. -# got: $Errno_Number -# expected: -1 -ERR - -#line 84 -use_ok('Hooble::mooble::yooble'); - -my $more_err_re = <<ERR; -# Failed test 'use Hooble::mooble::yooble;' -# at $Filename line 84\\. -# Tried to use 'Hooble::mooble::yooble'. -# Error: Can't locate Hooble.* in \\\@INC .* -ERR - -My::Test::like($err->read, "/^$more_err_re/"); - - -#line 85 -require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'); -$more_err_re = <<ERR; -# Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;' -# at $Filename line 85\\. -# Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'. -# Error: Can't locate ALL.* in \\\@INC .* -ERR - -My::Test::like($err->read, "/^$more_err_re/"); - - -#line 88 -END { - $TB->is_eq($$out, <<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 - ->can(...) -not ok - ARRAY->can('foo') -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 - new() died -not ok - new() died -not ok - The object isa Foo -not ok - The object isa Bar -not ok - The object isa Baz -not ok - no args isa Baz -not ok - cmp_ok eq -not ok - == -not ok - != -not ok - && -not ok - eq with numbers -not ok - == with strings -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 - -err_ok( <<ERR ); -# Looks like you failed $Total tests of $Total. -ERR - - exit(0); -} diff --git a/gnu/usr.bin/perl/lib/Test/t/fail_one.t b/gnu/usr.bin/perl/lib/Test/t/fail_one.t deleted file mode 100644 index 46b181d6a10..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/fail_one.t +++ /dev/null @@ -1,62 +0,0 @@ -#!/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 at $0 line 45. -# Looks like you failed 1 test of 1. -ERR - - # Prevent Test::Simple from existing with non-zero - exit 0; -} diff --git a/gnu/usr.bin/perl/lib/Test/t/filehandles.t b/gnu/usr.bin/perl/lib/Test/t/filehandles.t deleted file mode 100644 index f7dad5d7ea6..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/filehandles.t +++ /dev/null @@ -1,18 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } -} - -use lib 't/lib'; -use Test::More tests => 1; -use Dev::Null; - -tie *STDOUT, "Dev::Null" or die $!; - -print "not ok 1\n"; # this should not print. -pass 'STDOUT can be mucked with'; - diff --git a/gnu/usr.bin/perl/lib/Test/t/fork.t b/gnu/usr.bin/perl/lib/Test/t/fork.t deleted file mode 100644 index 55d7aec1f9a..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/fork.t +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More; -use Config; - -my $Can_Fork = $Config{d_fork} || - (($^O eq 'MSWin32' || $^O eq 'NetWare') and - $Config{useithreads} and - $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ - ); - -if( !$Can_Fork ) { - plan skip_all => "This system cannot fork"; -} -else { - plan tests => 1; -} - -if( fork ) { # parent - pass("Only the parent should process the ending, not the child"); -} -else { - exit; # child -} - diff --git a/gnu/usr.bin/perl/lib/Test/t/harness_active.t b/gnu/usr.bin/perl/lib/Test/t/harness_active.t deleted file mode 100644 index 7b027a7b404..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/harness_active.t +++ /dev/null @@ -1,88 +0,0 @@ -#!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; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 4); - -# Utility testing functions. -sub ok ($;$) { - return $TB->ok(@_); -} - - -sub main::err_ok ($) { - my($expect) = @_; - my $got = $err->read; - - return $TB->is_eq( $got, $expect ); -} - - -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_ok( <<ERR ); -# Failed test 'this fails' -# at $0 line 62. -ERR - -#line 72 - is( 1, 0 ); - err_ok( <<ERR ); -# Failed test at $0 line 72. -# got: '1' -# expected: '0' -ERR -} - -{ - local $ENV{HARNESS_ACTIVE} = 1; - -#line 71 - fail( "this fails" ); - err_ok( <<ERR ); - -# Failed test 'this fails' -# at $0 line 71. -ERR - - -#line 84 - is( 1, 0 ); - err_ok( <<ERR ); - -# Failed test at $0 line 84. -# got: '1' -# expected: '0' -ERR - -} diff --git a/gnu/usr.bin/perl/lib/Test/t/import.t b/gnu/usr.bin/perl/lib/Test/t/import.t deleted file mode 100644 index 68a36138bc9..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/import.t +++ /dev/null @@ -1,12 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - - -use Test::More tests => 2, import => [qw(!fail)]; - -can_ok(__PACKAGE__, qw(ok pass like isa_ok)); -ok( !__PACKAGE__->can('fail'), 'fail() not exported' ); diff --git a/gnu/usr.bin/perl/lib/Test/t/is_deeply_dne_bug.t b/gnu/usr.bin/perl/lib/Test/t/is_deeply_dne_bug.t deleted file mode 100644 index f4578a6460e..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/is_deeply_dne_bug.t +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/perl -w - -# test for rt.cpan.org 20768 -# -# There was a bug where the internal "does not exist" object could get -# confused with an overloaded object. - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 2; - -{ - package Foo; - - use overload - 'eq' => \&overload_equiv, - '==' => \&overload_equiv; - - sub new { - return bless {}, shift; - } - - sub overload_equiv { - if (ref($_[0]) ne 'Foo' || ref($_[1]) ne 'Foo') { - print ref($_[0]), " ", ref($_[1]), "\n"; - die "Invalid object passed to overload_equiv\n"; - } - - return 1; # change to 0 ... makes little difference - } -} - -my $obj1 = Foo->new(); -my $obj2 = Foo->new(); - -eval { is_deeply([$obj1, $obj2], [$obj1, $obj2]); }; -is $@, ''; - diff --git a/gnu/usr.bin/perl/lib/Test/t/is_deeply_fail.t b/gnu/usr.bin/perl/lib/Test/t/is_deeply_fail.t deleted file mode 100644 index bd9b6342333..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/is_deeply_fail.t +++ /dev/null @@ -1,371 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -use Test::Builder; -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; - - -my $TB = Test::Builder->create; -$TB->plan(tests => 73); - -# Utility testing functions. -sub ok ($;$) { - return $TB->ok(@_); -} - -sub is ($$;$) { - my($this, $that, $name) = @_; - - my $ok = $TB->is_eq($$this, $that, $name); - - $$this = ''; - - return $ok; -} - -sub like ($$;$) { - my($this, $regex, $name) = @_; - $regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s; - - my $ok = $TB->like($$this, $regex, $name); - - $$this = ''; - - return $ok; -} - - -require Test::More; -Test::More->import(tests => 11, import => ['is_deeply']); - -my $Filename = quotemeta $0; - -#line 68 -ok !is_deeply('foo', 'bar', 'plain strings'); -is( $out, "not ok 1 - plain strings\n", 'plain strings' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'plain strings' -# at $0 line 68. -# got: 'foo' -# expected: 'bar' -ERR - - -#line 78 -ok !is_deeply({}, [], 'different types'); -is( $out, "not ok 2 - different types\n", 'different types' ); -like( $err, <<ERR, ' right diagnostic' ); -# Failed test 'different types' -# at $Filename line 78. -# Structures begin differing at: -# \\\$got = HASH\\(0x[0-9a-f]+\\) -# \\\$expected = ARRAY\\(0x[0-9a-f]+\\) -ERR - -#line 88 -ok !is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values'); -is( $out, "not ok 3 - hashes with different values\n", - 'hashes with different values' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'hashes with different values' -# at $0 line 88. -# Structures begin differing at: -# \$got->{this} = '42' -# \$expected->{this} = '43' -ERR - -#line 99 -ok !is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys'); -is( $out, "not ok 4 - hashes with different keys\n", - 'hashes with different keys' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'hashes with different keys' -# at $0 line 99. -# Structures begin differing at: -# \$got->{this} = Does not exist -# \$expected->{this} = '42' -ERR - -#line 110 -ok !is_deeply([1..9], [1..10], 'arrays of different length'); -is( $out, "not ok 5 - arrays of different length\n", - 'arrays of different length' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'arrays of different length' -# at $0 line 110. -# Structures begin differing at: -# \$got->[9] = Does not exist -# \$expected->[9] = '10' -ERR - -#line 121 -ok !is_deeply([undef, undef], [undef], 'arrays of undefs' ); -is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'arrays of undefs' -# at $0 line 121. -# Structures begin differing at: -# \$got->[1] = undef -# \$expected->[1] = Does not exist -ERR - -#line 131 -ok !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 'hashes of undefs' -# at $0 line 131. -# Structures begin differing at: -# \$got->{foo} = undef -# \$expected->{foo} = Does not exist -ERR - -#line 141 -ok !is_deeply(\42, \23, 'scalar refs'); -is( $out, "not ok 8 - scalar refs\n", 'scalar refs' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'scalar refs' -# at $0 line 141. -# Structures begin differing at: -# \${ \$got} = '42' -# \${\$expected} = '23' -ERR - -#line 151 -ok !is_deeply([], \23, 'mixed scalar and array refs'); -is( $out, "not ok 9 - mixed scalar and array refs\n", - 'mixed scalar and array refs' ); -like( $err, <<ERR, ' right diagnostic' ); -# Failed test 'mixed scalar and array refs' -# at $Filename line 151. -# Structures begin differing at: -# \\\$got = ARRAY\\(0x[0-9a-f]+\\) -# \\\$expected = SCALAR\\(0x[0-9a-f]+\\) -ERR - - -my($a1, $a2, $a3); -$a1 = \$a2; $a2 = \$a3; -$a3 = 42; - -my($b1, $b2, $b3); -$b1 = \$b2; $b2 = \$b3; -$b3 = 23; - -#line 173 -ok !is_deeply($a1, $b1, 'deep scalar refs'); -is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'deep scalar refs' -# at $0 line 173. -# Structures begin differing at: -# \${\${ \$got}} = '42' -# \${\${\$expected}} = '23' -ERR - -# I don't know how to properly display this structure. -# $a2 = { foo => \$a3 }; -# $b2 = { foo => \$b3 }; -# is_deeply([$a1], [$b1], 'deep mixed scalar refs'); - -my $foo = { - this => [1..10], - that => { up => "down", left => "right" }, - }; - -my $bar = { - this => [1..10], - that => { up => "down", left => "right", foo => 42 }, - }; - -#line 198 -ok !is_deeply( $foo, $bar, 'deep structures' ); -ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); -is( $out, "not ok 11 - deep structures\n", 'deep structures' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'deep structures' -# at $0 line 198. -# Structures begin differing at: -# \$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 '', @_; }; - ok !is_deeply(@$test); - - like \$warning, - "/^is_deeply\\(\\) takes two or three args, you gave $num_args\.\n/"; -} - - -#line 240 -# [rt.cpan.org 6837] -ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""'; -ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); - - -#line 258 -# [rt.cpan.org 7031] -my $a = []; -ok !is_deeply($a, $a.''), "don't compare refs like strings"; -ok !is_deeply([$a], [$a.'']), " even deep inside"; - - -#line 265 -# [rt.cpan.org 7030] -ok !is_deeply( {}, {key => []} ), '[] could match non-existent values'; -ok !is_deeply( [], [[]] ); - - -#line 273 -$$err = $$out = ''; -ok !is_deeply( [\'a', 'b'], [\'a', 'c'] ); -is( $out, "not ok 20\n", 'scalar refs in an array' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test at $0 line 274. -# Structures begin differing at: -# \$got->[1] = 'b' -# \$expected->[1] = 'c' -ERR - - -#line 285 -my $ref = \23; -ok !is_deeply( 23, $ref ); -is( $out, "not ok 21\n", 'scalar vs ref' ); -is( $err, <<ERR, ' right diagnostic'); -# Failed test at $0 line 286. -# Structures begin differing at: -# \$got = '23' -# \$expected = $ref -ERR - -#line 296 -ok !is_deeply( $ref, 23 ); -is( $out, "not ok 22\n", 'ref vs scalar' ); -is( $err, <<ERR, ' right diagnostic'); -# Failed test at $0 line 296. -# Structures begin differing at: -# \$got = $ref -# \$expected = '23' -ERR - -#line 306 -ok !is_deeply( undef, [] ); -is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' ); -like( $err, <<ERR, ' right diagnostic' ); -# Failed test at $Filename line 306\\. -# Structures begin differing at: -# \\\$got = undef -# \\\$expected = ARRAY\\(0x[0-9a-f]+\\) -ERR - - -# rt.cpan.org 8865 -{ - my $array = []; - my $hash = {}; - -#line 321 - ok !is_deeply( $array, $hash ); - is( $out, "not ok 24\n", 'is_deeply and different reference types' ); - is( $err, <<ERR, ' right diagnostic' ); -# Failed test at $0 line 321. -# Structures begin differing at: -# \$got = $array -# \$expected = $hash -ERR - -#line 332 - ok !is_deeply( [$array], [$hash] ); - is( $out, "not ok 25\n", 'nested different ref types' ); - is( $err, <<ERR, ' right diagnostic' ); -# Failed test at $0 line 332. -# Structures begin differing at: -# \$got->[0] = $array -# \$expected->[0] = $hash -ERR - - - # Overloaded object tests - { - my $foo = bless [], "Foo"; - my $bar = bless {}, "Bar"; - - { - package Bar; - "overload"->import(q[""] => sub { "wibble" }); - } - -#line 353 - ok !is_deeply( [$foo], [$bar] ); - is( $out, "not ok 26\n", 'string overloaded refs respected in diag' ); - is( $err, <<ERR, ' right diagnostic' ); -# Failed test at $0 line 353. -# Structures begin differing at: -# \$got->[0] = $foo -# \$expected->[0] = 'wibble' -ERR - - } -} - - -# rt.cpan.org 14746 -{ -# line 349 - ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs'; - is( $out, "not ok 27\n" ); - like( $err, <<ERR, ' right diagnostic' ); -# Failed test at $Filename line 349. -# Structures begin differing at: -# \\\$got = CODE\\(0x[0-9a-f]+\\) -# \\\$expected = CODE\\(0x[0-9a-f]+\\) -ERR - - - use Symbol; - my $glob1 = gensym; - my $glob2 = gensym; - -#line 357 - ok !is_deeply( $glob1, $glob2 ), 'typeglobs'; - is( $out, "not ok 28\n" ); - like( $err, <<ERR, ' right diagnostic' ); -# Failed test at $Filename line 357. -# Structures begin differing at: -# \\\$got = GLOB\\(0x[0-9a-f]+\\) -# \\\$expected = GLOB\\(0x[0-9a-f]+\\) -ERR - -} diff --git a/gnu/usr.bin/perl/lib/Test/t/is_deeply_with_threads.t b/gnu/usr.bin/perl/lib/Test/t/is_deeply_with_threads.t deleted file mode 100644 index 9908ef66083..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/is_deeply_with_threads.t +++ /dev/null @@ -1,65 +0,0 @@ -#!/usr/bin/perl -w - -# Test to see if is_deeply() plays well with threads. - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Config; - -BEGIN { - unless ( $] >= 5.008001 && $Config{'useithreads'} && - eval { require threads; 'threads'->import; 1; }) - { - print "1..0 # Skip no working threads\n"; - exit 0; - } - - unless ( $ENV{AUTHOR_TESTING} ) { - print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n"; - exit 0; - } -} -use Test::More; - -my $Num_Threads = 5; - -plan tests => $Num_Threads * 100 + 6; - - -sub do_one_thread { - my $kid = shift; - my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z', - 'hello', 's', 'thisisalongname', '1', '2', '3', - 'abc', 'xyz', '1234567890', 'm', 'n', 'p' ); - my @list2 = @list; - print "# kid $kid before is_deeply\n"; - - for my $j (1..100) { - is_deeply(\@list, \@list2); - } - print "# kid $kid exit\n"; - return 42; -} - -my @kids = (); -for my $i (1..$Num_Threads) { - my $t = threads->new(\&do_one_thread, $i); - print "# parent $$: continue\n"; - push(@kids, $t); -} -for my $t (@kids) { - print "# parent $$: waiting for join\n"; - my $rc = $t->join(); - cmp_ok( $rc, '==', 42, "threads exit status is $rc" ); -} - -pass("End of test"); diff --git a/gnu/usr.bin/perl/lib/Test/t/missing.t b/gnu/usr.bin/perl/lib/Test/t/missing.t deleted file mode 100644 index 3996b6de4b4..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/missing.t +++ /dev/null @@ -1,56 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 2); - -sub is { $TB->is_eq(@_) } - - -package main; - -require Test::Simple; - -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); -local $ENV{HARNESS_ACTIVE} = 0; - -Test::Simple->import(tests => 5); - -#line 30 -ok(1, 'Foo'); -ok(0, 'Bar'); -ok(1, '1 2 3'); - -END { - My::Test::is($$out, <<OUT); -1..5 -ok 1 - Foo -not ok 2 - Bar -ok 3 - 1 2 3 -OUT - - My::Test::is($$err, <<ERR); -# Failed test 'Bar' -# at $0 line 31. -# You named your test '1 2 3'. You shouldn't use numbers for your test names. -# Very confusing. -# Looks like you planned 5 tests but ran 3. -# Looks like you failed 1 test of 3 run. -ERR - - exit 0; -} diff --git a/gnu/usr.bin/perl/lib/Test/t/new_ok.t b/gnu/usr.bin/perl/lib/Test/t/new_ok.t deleted file mode 100644 index d53f535d1c0..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/new_ok.t +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Test::More tests => 13; - -{ - package Bar; - - sub new { - my $class = shift; - return bless {@_}, $class; - } - - - package Foo; - our @ISA = qw(Bar); -} - -{ - my $obj = new_ok("Foo"); - is_deeply $obj, {}; - isa_ok $obj, "Foo"; - - $obj = new_ok("Bar"); - is_deeply $obj, {}; - isa_ok $obj, "Bar"; - - $obj = new_ok("Foo", [this => 42]); - is_deeply $obj, { this => 42 }; - isa_ok $obj, "Foo"; - - $obj = new_ok("Foo", [], "Foo"); - is_deeply $obj, {}; - isa_ok $obj, "Foo"; -} - -# And what if we give it nothing? -eval { - new_ok(); -}; -is $@, sprintf "new_ok() must be given at least a class at %s line %d.\n", $0, __LINE__ - 2; diff --git a/gnu/usr.bin/perl/lib/Test/t/no_plan.t b/gnu/usr.bin/perl/lib/Test/t/no_plan.t deleted file mode 100644 index 2231c0f5535..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/no_plan.t +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More tests => 9; - -my $tb = Test::Builder->create; -$tb->level(0); - -#line 20 -ok !eval { $tb->plan(tests => undef) }; -is($@, "Got an undefined number of tests at $0 line 20.\n"); - -#line 24 -ok !eval { $tb->plan(tests => 0) }; -is($@, "You said to run 0 tests at $0 line 24.\n"); - -#line 28 -ok !eval { $tb->ok(1) }; -is( $@, "You tried to run a test without a plan at $0 line 28.\n"); - -{ - my $warning = ''; - local $SIG{__WARN__} = sub { $warning .= join '', @_ }; - -#line 36 - ok $tb->plan(no_plan => 1); - is( $warning, "no_plan takes no arguments at $0 line 36.\n" ); - is $tb->has_plan, 'no_plan'; -} diff --git a/gnu/usr.bin/perl/lib/Test/t/no_tests.t b/gnu/usr.bin/perl/lib/Test/t/no_tests.t deleted file mode 100644 index eafa38cacc7..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/no_tests.t +++ /dev/null @@ -1,44 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 3); - - -package main; - -require Test::Simple; - -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 => 1); - -END { - $TB->is_eq($out->read, <<OUT); -1..1 -OUT - - $TB->is_eq($err->read, <<ERR); -# No tests run! -ERR - - $TB->is_eq($?, 255, "exit code"); - - exit grep { !$_ } $TB->summary; -} diff --git a/gnu/usr.bin/perl/lib/Test/t/note.t b/gnu/usr.bin/perl/lib/Test/t/note.t deleted file mode 100644 index 1142b426ed1..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/note.t +++ /dev/null @@ -1,35 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use warnings; - -use TieOut; - -use Test::More tests => 2; - -{ - my $test = Test::More->builder; - - my $output = tie *FAKEOUT, "TieOut"; - my $fail_output = tie *FAKEERR, "TieOut"; - $test->output (*FAKEOUT); - $test->failure_output(*FAKEERR); - - note("foo"); - - $test->reset_outputs; - - is $output->read, "# foo\n"; - is $fail_output->read, ''; -} - diff --git a/gnu/usr.bin/perl/lib/Test/t/overload.t b/gnu/usr.bin/perl/lib/Test/t/overload.t deleted file mode 100644 index c7d6f3717c7..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/overload.t +++ /dev/null @@ -1,75 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 15; - - -package Overloaded; - -use overload - q{eq} => sub { $_[0]->{string} }, - q{==} => sub { $_[0]->{num} }, - q{""} => sub { $_[0]->{stringfy}++; $_[0]->{string} }, - q{0+} => sub { $_[0]->{numify}++; $_[0]->{num} } -; - -sub new { - my $class = shift; - bless { - string => shift, - num => shift, - stringify => 0, - numify => 0, - }, $class; -} - - -package main; - -local $SIG{__DIE__} = sub { - my($call_file, $call_line) = (caller)[1,2]; - fail("SIGDIE accidentally called"); - diag("From $call_file at $call_line"); -}; - -my $obj = Overloaded->new('foo', 42); -isa_ok $obj, 'Overloaded'; - -is $obj, 'foo', 'is() with string overloading'; -cmp_ok $obj, 'eq', 'foo', 'cmp_ok() ...'; -is $obj->{stringify}, 0, 'cmp_ok() eq does not stringify'; -cmp_ok $obj, '==', 42, 'cmp_ok() with number overloading'; -is $obj->{numify}, 0, 'cmp_ok() == does not numify'; - -is_deeply [$obj], ['foo'], 'is_deeply with string overloading'; -ok eq_array([$obj], ['foo']), 'eq_array ...'; -ok eq_hash({foo => $obj}, {foo => 'foo'}), 'eq_hash ...'; - -# rt.cpan.org 13506 -is_deeply $obj, 'foo', 'is_deeply with string overloading at the top'; - -Test::More->builder->is_num($obj, 42); -Test::More->builder->is_eq ($obj, "foo"); - - -{ - # rt.cpan.org 14675 - package TestPackage; - use overload q{""} => sub { ::fail("This should not be called") }; - - package Foo; - ::is_deeply(['TestPackage'], ['TestPackage']); - ::is_deeply({'TestPackage' => 'TestPackage'}, - {'TestPackage' => 'TestPackage'}); - ::is_deeply('TestPackage', 'TestPackage'); -} diff --git a/gnu/usr.bin/perl/lib/Test/t/overload_threads.t b/gnu/usr.bin/perl/lib/Test/t/overload_threads.t deleted file mode 100644 index 379e347baeb..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/overload_threads.t +++ /dev/null @@ -1,60 +0,0 @@ -#!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 tests => 5; - - -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 '', @_ }; - -# overloaded object as name -my $obj = Overloaded->new('foo'); -ok( 1, $obj ); - -# overloaded object which returns undef as name -my $undef = Overloaded->new(undef); -pass( $undef ); - -is( $warnings, '' ); - - -TODO: { - my $obj = Overloaded->new('not really todo, testing overloaded reason'); - local $TODO = $obj; - fail("Just checking todo as an overloaded value"); -} - - -SKIP: { - my $obj = Overloaded->new('not really skipped, testing overloaded reason'); - skip $obj, 1; -} diff --git a/gnu/usr.bin/perl/lib/Test/t/plan.t b/gnu/usr.bin/perl/lib/Test/t/plan.t deleted file mode 100644 index 0d3ce89edb1..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/plan.t +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More; - -plan tests => 4; -eval { plan tests => 4 }; -is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ - 1), - 'disallow double plan' ); -eval { plan 'no_plan' }; -is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ -1), - 'disallow changing plan' ); - -pass('Just testing plan()'); -pass('Testing it some more'); diff --git a/gnu/usr.bin/perl/lib/Test/t/plan_bad.t b/gnu/usr.bin/perl/lib/Test/t/plan_bad.t deleted file mode 100644 index 179356dbc1d..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/plan_bad.t +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - - -use Test::More tests => 12; -use Test::Builder; -my $tb = Test::Builder->create; -$tb->level(0); - -ok !eval { $tb->plan( tests => 'no_plan' ); }; -is $@, sprintf "Number of tests must be a positive integer. You gave it 'no_plan' at %s line %d.\n", $0, __LINE__ - 1; - -my $foo = []; -my @foo = ($foo, 2, 3); -ok !eval { $tb->plan( tests => @foo ) }; -is $@, sprintf "Number of tests must be a positive integer. You gave it '$foo' at %s line %d.\n", $0, __LINE__ - 1; - -ok !eval { $tb->plan( tests => 9.99 ) }; -is $@, sprintf "Number of tests must be a positive integer. You gave it '9.99' at %s line %d.\n", $0, __LINE__ - 1; - -#line 25 -ok !eval { $tb->plan( tests => -1 ) }; -is $@, "Number of tests must be a positive integer. You gave it '-1' at $0 line 25.\n"; - -#line 29 -ok !eval { $tb->plan( tests => '' ) }; -is $@, "You said to run 0 tests at $0 line 29.\n"; - -#line 33 -ok !eval { $tb->plan( 'wibble' ) }; -is $@, "plan() doesn't understand wibble at $0 line 33.\n"; diff --git a/gnu/usr.bin/perl/lib/Test/t/plan_is_noplan.t b/gnu/usr.bin/perl/lib/Test/t/plan_is_noplan.t deleted file mode 100644 index e39cd4062b7..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/plan_is_noplan.t +++ /dev/null @@ -1,54 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -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; - -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); - - -Test::Simple->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::Simple from exiting with non zero - exit 0; -} diff --git a/gnu/usr.bin/perl/lib/Test/t/plan_no_plan.t b/gnu/usr.bin/perl/lib/Test/t/plan_no_plan.t deleted file mode 100644 index 3111592e97f..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/plan_no_plan.t +++ /dev/null @@ -1,40 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More; - -BEGIN { - if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) { - plan skip_all => "Won't work with t/TEST"; - } -} - -plan 'no_plan'; - -pass('Just testing'); -ok(1, 'Testing again'); - -{ - my $warning = ''; - local $SIG{__WARN__} = sub { $warning = join "", @_ }; - SKIP: { - skip 'Just testing skip with no_plan'; - fail("So very failed"); - } - is( $warning, '', 'skip with no "how_many" ok with no_plan' ); - - - $warning = ''; - TODO: { - todo_skip "Just testing todo_skip"; - - fail("Just testing todo"); - die "todo_skip should prevent this"; - pass("Again"); - } - is( $warning, '', 'skip with no "how_many" ok with no_plan' ); -} diff --git a/gnu/usr.bin/perl/lib/Test/t/plan_shouldnt_import.t b/gnu/usr.bin/perl/lib/Test/t/plan_shouldnt_import.t deleted file mode 100644 index b6eb0642446..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/plan_shouldnt_import.t +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/perl -w - -# plan() used to export functions by mistake [rt.cpan.org 8385] - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - - -use Test::More (); -Test::More::plan(tests => 1); - -Test::More::ok( !__PACKAGE__->can('ok'), 'plan should not export' ); diff --git a/gnu/usr.bin/perl/lib/Test/t/plan_skip_all.t b/gnu/usr.bin/perl/lib/Test/t/plan_skip_all.t deleted file mode 100644 index 528df5f50d4..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/plan_skip_all.t +++ /dev/null @@ -1,12 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More; - -plan skip_all => 'Just testing plan & skip_all'; - -fail('We should never get here'); diff --git a/gnu/usr.bin/perl/lib/Test/t/require_ok.t b/gnu/usr.bin/perl/lib/Test/t/require_ok.t deleted file mode 100644 index 463a007599c..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/require_ok.t +++ /dev/null @@ -1,29 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 8; - -# Symbol and Class::Struct are both non-XS core modules back to 5.004. -# So they'll always be there. -require_ok("Symbol"); -ok( $INC{'Symbol.pm'}, "require_ok MODULE" ); - -require_ok("Class/Struct.pm"); -ok( $INC{'Class/Struct.pm'}, "require_ok FILE" ); - -# Its more trouble than its worth to try to create these filepaths to test -# through require_ok() so we cheat and use the internal logic. -ok !Test::More::_is_module_name('foo:bar'); -ok !Test::More::_is_module_name('foo/bar.thing'); -ok !Test::More::_is_module_name('Foo::Bar::'); -ok Test::More::_is_module_name('V'); diff --git a/gnu/usr.bin/perl/lib/Test/t/simple.t b/gnu/usr.bin/perl/lib/Test/t/simple.t deleted file mode 100644 index 7297e9d6dd1..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/simple.t +++ /dev/null @@ -1,17 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; - -BEGIN { $| = 1; $^W = 1; } - -use Test::Simple tests => 3; - -ok(1, 'compile'); - -ok(1); -ok(1, 'foo'); diff --git a/gnu/usr.bin/perl/lib/Test/t/skipall.t b/gnu/usr.bin/perl/lib/Test/t/skipall.t deleted file mode 100644 index 6f255e21ce5..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/skipall.t +++ /dev/null @@ -1,44 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -# 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; - -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); - -Test::More->import('skip_all'); - - -END { - My::Test::ok($$out eq "1..0\n"); - My::Test::ok($$err eq ""); -} diff --git a/gnu/usr.bin/perl/lib/Test/t/tbm_doesnt_set_exported_to.t b/gnu/usr.bin/perl/lib/Test/t/tbm_doesnt_set_exported_to.t deleted file mode 100644 index 8bdd17753b1..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/tbm_doesnt_set_exported_to.t +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use warnings; - -# Can't use Test::More, that would set exported_to() -use Test::Builder; -use Test::Builder::Module; - -my $TB = Test::Builder->create; -$TB->plan( tests => 1 ); -$TB->level(0); - -$TB->is_eq( Test::Builder::Module->builder->exported_to, - undef, - 'using Test::Builder::Module does not set exported_to()' -); diff --git a/gnu/usr.bin/perl/lib/Test/t/thread_taint.t b/gnu/usr.bin/perl/lib/Test/t/thread_taint.t deleted file mode 100644 index ef7b89daeff..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/thread_taint.t +++ /dev/null @@ -1,5 +0,0 @@ -#!/usr/bin/perl -w - -use Test::More tests => 1; - -ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' ); diff --git a/gnu/usr.bin/perl/lib/Test/t/threads.t b/gnu/usr.bin/perl/lib/Test/t/threads.t deleted file mode 100644 index 42ba8c269c7..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/threads.t +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Config; -BEGIN { - unless ( $] >= 5.008001 && $Config{'useithreads'} && - eval { require threads; 'threads'->import; 1; }) - { - print "1..0 # Skip: no working threads\n"; - exit 0; - } -} - -use strict; -use Test::Builder; - -my $Test = Test::Builder->new; -$Test->exported_to('main'); -$Test->plan(tests => 6); - -for(1..5) { - 'threads'->create(sub { - $Test->ok(1,"Each of these should app the test number") - })->join; -} - -$Test->is_num($Test->current_test(), 5,"Should be five"); diff --git a/gnu/usr.bin/perl/lib/Test/t/undef.t b/gnu/usr.bin/perl/lib/Test/t/undef.t deleted file mode 100644 index 0e72419b0de..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/undef.t +++ /dev/null @@ -1,95 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 20; -use TieOut; - -BEGIN { $^W = 1; } - -my $warnings = ''; -local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; - -my $TB = Test::Builder->new; -sub no_warnings { - $TB->is_eq($warnings, '', ' no warnings'); - $warnings = ''; -} - -sub warnings_is { - $TB->is_eq($warnings, $_[0]); - $warnings = ''; -} - -sub warnings_like { - $TB->like($warnings, $_[0]); - $warnings = ''; -} - - -my $Filename = quotemeta $0; - - -is( undef, undef, 'undef is undef'); -no_warnings; - -isnt( undef, 'foo', 'undef isnt foo'); -no_warnings; - -isnt( undef, '', 'undef isnt an empty string' ); -isnt( undef, 0, 'undef isnt zero' ); - -Test::More->builder->is_num(undef, undef, 'is_num()'); -Test::More->builder->isnt_num(23, undef, 'isnt_num()'); - -#line 45 -like( undef, '/.*/', 'undef is like anything' ); -warnings_like(qr/Use of uninitialized value.* at $Filename line 45\.\n/); - -eq_array( [undef, undef], [undef, 23] ); -no_warnings; - -eq_hash ( { foo => undef, bar => undef }, - { foo => undef, bar => 23 } ); -no_warnings; - -eq_set ( [undef, undef, 12], [29, undef, undef] ); -no_warnings; - - -eq_hash ( { foo => undef, bar => { baz => undef, moo => 23 } }, - { foo => undef, bar => { baz => undef, moo => 23 } } ); -no_warnings; - - -#line 64 -cmp_ok( undef, '<=', 2, ' undef <= 2' ); -warnings_like(qr/Use of uninitialized value.* at cmp_ok \[from $Filename line 64\] line 1\.\n/); - - - -my $tb = Test::More->builder; - -use TieOut; -my $caught = tie *CATCH, 'TieOut'; -my $old_fail = $tb->failure_output; -$tb->failure_output(\*CATCH); -diag(undef); -$tb->failure_output($old_fail); - -is( $caught->read, "# undef\n" ); -no_warnings; - - -$tb->maybe_regex(undef); -is( $caught->read, '' ); -no_warnings; diff --git a/gnu/usr.bin/perl/lib/Test/t/use_ok.t b/gnu/usr.bin/perl/lib/Test/t/use_ok.t deleted file mode 100644 index 4a62f3557e8..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/use_ok.t +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = qw(../lib ../lib/Test/Simple/t/lib); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More tests => 15; - -# Using Symbol because it's core and exports lots of stuff. -{ - package Foo::one; - ::use_ok("Symbol"); - ::ok( defined &gensym, 'use_ok() no args exports defaults' ); -} - -{ - package Foo::two; - ::use_ok("Symbol", qw(qualify)); - ::ok( !defined &gensym, ' one arg, defaults overriden' ); - ::ok( defined &qualify, ' right function exported' ); -} - -{ - package Foo::three; - ::use_ok("Symbol", qw(gensym ungensym)); - ::ok( defined &gensym && defined &ungensym, ' multiple args' ); -} - -{ - package Foo::four; - my $warn; local $SIG{__WARN__} = sub { $warn .= shift; }; - ::use_ok("constant", qw(foo bar)); - ::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); -} - -{ - package Foo::eight; - local $SIG{__DIE__}; - ::use_ok("SigDie"); - ::ok(defined $SIG{__DIE__}, ' SIG{__DIE__} preserved'); -} diff --git a/gnu/usr.bin/perl/lib/Test/t/useing.t b/gnu/usr.bin/perl/lib/Test/t/useing.t deleted file mode 100644 index c4ce5071270..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/useing.t +++ /dev/null @@ -1,19 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More tests => 5; - -require_ok('Test::Builder'); -require_ok("Test::More"); -require_ok("Test::Simple"); - -{ - package Foo; - use Test::More import => [qw(ok is can_ok)]; - can_ok('Foo', qw(ok is can_ok)); - ok( !Foo->can('like'), 'import working properly' ); -} diff --git a/gnu/usr.bin/perl/lib/Test/t/utf8.t b/gnu/usr.bin/perl/lib/Test/t/utf8.t deleted file mode 100644 index c7e93c3ac2d..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/utf8.t +++ /dev/null @@ -1,69 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use warnings; - -use Test::More skip_all => 'Not yet implemented'; - -my $have_perlio; -BEGIN { - # All together so Test::More sees the open discipline - $have_perlio = eval q[ - use PerlIO; - use open ':std', ':locale'; - use Test::More; - 1; - ]; -} - -use Test::More; - -if( !$have_perlio ) { - plan skip_all => "Don't have PerlIO"; -} -else { - plan tests => 5; -} - -SKIP: { - skip( "Need PerlIO for this feature", 3 ) - unless $have_perlio; - - my %handles = ( - output => \*STDOUT, - failure_output => \*STDERR, - todo_output => \*STDOUT - ); - - for my $method (keys %handles) { - my $src = $handles{$method}; - - my $dest = Test::More->builder->$method; - - is_deeply { map { $_ => 1 } PerlIO::get_layers($dest) }, - { map { $_ => 1 } PerlIO::get_layers($src) }, - "layers copied to $method"; - } -} - -SKIP: { - skip( "Can't test in general because their locale is unknown", 2 ) - unless $ENV{AUTHOR_TESTING}; - - my $uni = "\x{11e}"; - - my @warnings; - local $SIG{__WARN__} = sub { - push @warnings, @_; - }; - - is( $uni, $uni, "Testing $uni" ); - is_deeply( \@warnings, [] ); -} |