diff options
Diffstat (limited to 'gnu/usr.bin/perl/lib/Test/t')
53 files changed, 0 insertions, 3074 deletions
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/pod-coverage.t b/gnu/usr.bin/perl/lib/Test/t/pod-coverage.t deleted file mode 100644 index 87942726e76..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/pod-coverage.t +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/perl -w - -use Test::More; - -# 1.08 added the coverage_class option. -eval "use Test::Pod::Coverage 1.08"; -plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; -eval "use Pod::Coverage::CountParents"; -plan skip_all => "Pod::Coverage::CountParents required for testing POD coverage" if $@; - -my @modules = Test::Pod::Coverage::all_modules(); -plan tests => scalar @modules; - -my %coverage_params = ( - "Test::Builder" => { - also_private => [ '^(share|lock|BAILOUT)$' ] - }, - "Test::More" => { - trustme => [ '^(skip|todo)$' ] - }, -); - -for my $module (@modules) { - pod_coverage_ok( $module, { coverage_class => 'Pod::Coverage::CountParents', - %{$coverage_params{$module} || {}} } - ); -} diff --git a/gnu/usr.bin/perl/lib/Test/t/pod.t b/gnu/usr.bin/perl/lib/Test/t/pod.t deleted file mode 100644 index 3c931f94f91..00000000000 --- a/gnu/usr.bin/perl/lib/Test/t/pod.t +++ /dev/null @@ -1,6 +0,0 @@ -#!/usr/bin/perl -w - -use Test::More; -eval "use Test::Pod 1.00"; -plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; -all_pod_files_ok(); 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, [] ); -} |