diff options
Diffstat (limited to 'cpan/Test-Simple/t/Legacy')
121 files changed, 7092 insertions, 0 deletions
diff --git a/cpan/Test-Simple/t/Legacy/BEGIN_require_ok.t b/cpan/Test-Simple/t/Legacy/BEGIN_require_ok.t new file mode 100644 index 0000000000..733d0bb861 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/BEGIN_require_ok.t @@ -0,0 +1,27 @@ +#!/usr/bin/perl -w + +# Fixed a problem with BEGIN { use_ok or require_ok } silently failing when there's no +# plan set. [rt.cpan.org 28345] Thanks Adriano Ferreira and Yitzchak. + +use strict; + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::More; + +my $result; +BEGIN { + $result = require_ok("strict"); +} + +ok $result, "require_ok ran"; + +done_testing(2); diff --git a/cpan/Test-Simple/t/Legacy/BEGIN_use_ok.t b/cpan/Test-Simple/t/Legacy/BEGIN_use_ok.t new file mode 100644 index 0000000000..476badf7a2 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/BEGIN_use_ok.t @@ -0,0 +1,26 @@ +#!/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 { + $result = use_ok("strict"); +} + +ok( $result, "use_ok() ran" ); +done_testing(2); + diff --git a/cpan/Test-Simple/t/Legacy/Builder/Builder.t b/cpan/Test-Simple/t/Legacy/Builder/Builder.t new file mode 100644 index 0000000000..a5bfd155a6 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/Builder.t @@ -0,0 +1,30 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::Builder; +my $Test = Test::Builder->new; + +$Test->plan( tests => 7 ); + +my $default_lvl = $Test->level; +$Test->level(0); + +$Test->ok( 1, 'compiled and new()' ); +$Test->ok( $default_lvl == 1, 'level()' ); + +$Test->is_eq('foo', 'foo', 'is_eq'); +$Test->is_num('23.0', '23', 'is_num'); + +$Test->is_num( $Test->current_test, 4, 'current_test() get' ); + +my $test_num = $Test->current_test + 1; +$Test->current_test( $test_num ); +print "ok $test_num - current_test() set\n"; + +$Test->ok( 1, 'counter still good' ); diff --git a/cpan/Test-Simple/t/Legacy/Builder/carp.t b/cpan/Test-Simple/t/Legacy/Builder/carp.t new file mode 100644 index 0000000000..b6b5518d66 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/carp.t @@ -0,0 +1,33 @@ +#!/usr/bin/perl +use strict; +use warnings; + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + + +use Test::More tests => 3; +use Test::Builder; + +sub foo { my $ctx = context(); Test::Builder->new->croak("foo") } +sub bar { my $ctx = context(); Test::Builder->new->carp("bar") } + +eval { foo() }; +is $@, sprintf "foo at %s line %s.\n", $0, __LINE__ - 1; + +eval { Test::Builder->new->croak("this") }; +is $@, sprintf "this at %s line %s.\n", $0, __LINE__ - 1; + +{ + my $warning = ''; + local $SIG{__WARN__} = sub { + $warning .= join '', @_; + }; + + bar(); + is $warning, sprintf "bar at %s line %s.\n", $0, __LINE__ - 1; +} diff --git a/cpan/Test-Simple/t/Legacy/Builder/create.t b/cpan/Test-Simple/t/Legacy/Builder/create.t new file mode 100644 index 0000000000..64be8511d8 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/create.t @@ -0,0 +1,38 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::More tests => 7; +use Test::Builder; +use Test::Builder::NoOutput; + +my $more_tb = Test::More->builder; +isa_ok $more_tb, 'Test::Builder'; + +is $more_tb, Test::More->builder, 'create does not interfere with ->builder'; +is $more_tb, Test::Builder->new, ' does not interfere with ->new'; + +{ + my $new_tb = Test::Builder::NoOutput->create; + + isa_ok $new_tb, 'Test::Builder'; + isnt $more_tb, $new_tb, 'Test::Builder->create makes a new object'; + + $new_tb->plan(tests => 1); + $new_tb->ok(1, "a test"); + + is $new_tb->read, <<'OUT'; +1..1 +ok 1 - a test +OUT +} + +pass("Changing output() of new TB doesn't interfere with singleton"); diff --git a/cpan/Test-Simple/t/Legacy/Builder/current_test.t b/cpan/Test-Simple/t/Legacy/Builder/current_test.t new file mode 100644 index 0000000000..edd201c0e9 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/current_test.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl -w + +# 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/cpan/Test-Simple/t/Legacy/Builder/current_test_without_plan.t b/cpan/Test-Simple/t/Legacy/Builder/current_test_without_plan.t new file mode 100644 index 0000000000..31f9589977 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/current_test_without_plan.t @@ -0,0 +1,16 @@ +#!/usr/bin/perl -w + +# Test that current_test() will work without a declared plan. + +use Test::Builder; + +my $tb = Test::Builder->new; +$tb->current_test(2); +print <<'END'; +ok 1 +ok 2 +END + +$tb->ok(1, "Third test"); + +$tb->done_testing(3); diff --git a/cpan/Test-Simple/t/Legacy/Builder/details.t b/cpan/Test-Simple/t/Legacy/Builder/details.t new file mode 100644 index 0000000000..05d4828b4d --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/details.t @@ -0,0 +1,104 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::More; +use Test::Builder; +my $Test = Test::Builder->new; + +$Test->plan( tests => 9 ); +$Test->level(0); + +my @Expected_Details; + +$Test->is_num( scalar $Test->summary(), 0, 'no tests yet, no summary' ); +push @Expected_Details, { 'ok' => 1, + actual_ok => 1, + name => 'no tests yet, no summary', + type => '', + reason => '' + }; + +# Inline TODO tests will confuse pre 1.20 Test::Harness, so we +# should just avoid the problem and not print it out. +my $start_test = $Test->current_test + 1; + +my $output = ''; +$Test->output(\$output); +$Test->todo_output(\$output); + +SKIP: { + $Test->skip( 'just testing skip' ); +} +push @Expected_Details, { 'ok' => 1, + actual_ok => 1, + name => '', + type => 'skip', + reason => 'just testing skip', + }; + +TODO: { + local $TODO = 'i need a todo'; + $Test->ok( 0, 'a test to todo!' ); + + push @Expected_Details, { 'ok' => 1, + actual_ok => 0, + name => 'a test to todo!', + type => 'todo', + reason => 'i need a todo', + }; + + $Test->todo_skip( 'i need both' ); +} +push @Expected_Details, { 'ok' => 1, + actual_ok => 0, + name => '', + type => 'todo_skip', + reason => 'i need both' + }; + +for ($start_test..$Test->current_test) { print "ok $_\n" } +$Test->reset_outputs; + +$Test->is_num( scalar $Test->summary(), 4, 'summary' ); +push @Expected_Details, { 'ok' => 1, + actual_ok => 1, + name => 'summary', + type => '', + reason => '', + }; + +$Test->current_test(6); +print "ok 6 - current_test incremented\n"; +push @Expected_Details, { 'ok' => 1, + actual_ok => undef, + name => undef, + type => 'unknown', + reason => 'incrementing test number', + }; + +my @details = $Test->details(); +$Test->is_num( scalar @details, 6, + 'details() should return a list of all test details'); + +$Test->level(1); +is_deeply( \@details, \@Expected_Details ); + + +# This test has to come last because it thrashes the test details. +{ + my $curr_test = $Test->current_test; + $Test->current_test(4); + my @details = $Test->details(); + + $Test->current_test($curr_test); + $Test->is_num( scalar @details, 4 ); +} diff --git a/cpan/Test-Simple/t/Legacy/Builder/done_testing.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing.t new file mode 100644 index 0000000000..14a8f918b0 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing.t @@ -0,0 +1,12 @@ +#!/usr/bin/perl -w + +use strict; + +use Test::Builder; + +my $tb = Test::Builder->new; +$tb->level(0); + +$tb->ok(1, "testing done_testing() with no arguments"); +$tb->ok(1, " another test so we're not testing just one"); +$tb->done_testing(); diff --git a/cpan/Test-Simple/t/Legacy/Builder/done_testing_double.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing_double.t new file mode 100644 index 0000000000..3a0bae247b --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing_double.t @@ -0,0 +1,47 @@ +#!/usr/bin/perl -w + +use strict; +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::Builder; +use Test::Builder::NoOutput; + +my $tb = Test::Builder::NoOutput->create; + +{ + # Normalize test output + local $ENV{HARNESS_ACTIVE}; + + $tb->ok(1); + $tb->ok(1); + $tb->ok(1); + +#line 24 + $tb->done_testing(3); + $tb->done_testing; + $tb->done_testing; +} + +my $Test = Test::Builder->new; +$Test->plan( tests => 1 ); +$Test->level(0); +$Test->is_eq($tb->read, <<"END", "multiple done_testing"); +ok 1 +ok 2 +ok 3 +1..3 +not ok 4 - done_testing() was already called at $0 line 24 +# Failed test 'done_testing() was already called at $0 line 24' +# at $0 line 25. +not ok 5 - done_testing() was already called at $0 line 24 +# Failed test 'done_testing() was already called at $0 line 24' +# at $0 line 26. +END diff --git a/cpan/Test-Simple/t/Legacy/Builder/done_testing_plan_mismatch.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing_plan_mismatch.t new file mode 100644 index 0000000000..8208635359 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing_plan_mismatch.t @@ -0,0 +1,45 @@ +#!/usr/bin/perl -w + +# What if there's a plan and done_testing but they don't match? + +use strict; +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::Builder; +use Test::Builder::NoOutput; + +my $tb = Test::Builder::NoOutput->create; + +{ + # Normalize test output + local $ENV{HARNESS_ACTIVE}; + + $tb->plan( tests => 3 ); + $tb->ok(1); + $tb->ok(1); + $tb->ok(1); + +#line 24 + $tb->done_testing(2); +} + +my $Test = Test::Builder->new; +$Test->plan( tests => 1 ); +$Test->level(0); +$Test->is_eq($tb->read, <<"END"); +1..3 +ok 1 +ok 2 +ok 3 +not ok 4 - planned to run 3 but done_testing() expects 2 +# Failed test 'planned to run 3 but done_testing() expects 2' +# at $0 line 24. +END diff --git a/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_no_plan.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_no_plan.t new file mode 100644 index 0000000000..ff5f40c197 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_no_plan.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl -w + +use strict; + +use Test::Builder; + +my $tb = Test::Builder->new; +$tb->plan( "no_plan" ); +$tb->ok(1); +$tb->ok(1); +$tb->done_testing(2); diff --git a/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_number.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_number.t new file mode 100644 index 0000000000..c21458f54e --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_number.t @@ -0,0 +1,12 @@ +#!/usr/bin/perl -w + +use strict; + +use Test::Builder; + +my $tb = Test::Builder->new; +$tb->level(0); + +$tb->ok(1, "testing done_testing() with no arguments"); +$tb->ok(1, " another test so we're not testing just one"); +$tb->done_testing(2); diff --git a/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_plan.t b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_plan.t new file mode 100644 index 0000000000..2d10322eea --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/done_testing_with_plan.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl -w + +use strict; + +use Test::Builder; + +my $tb = Test::Builder->new; +$tb->plan(tests => 2); +$tb->ok(1); +$tb->ok(1); +$tb->done_testing(2); diff --git a/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t b/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t new file mode 100644 index 0000000000..bcd7156e89 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/fork_with_new_stdout.t @@ -0,0 +1,57 @@ +#!perl -w +use strict; +use warnings; +use IO::Pipe; +use Test::Builder; +use Config; + +my $b = Test::Builder->new; +$b->reset; + +my $Can_Fork = $Config{d_fork} + || (($^O eq 'MSWin32' || $^O eq 'NetWare') + and $Config{useithreads} + and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/); + +if (!$Can_Fork) { + $b->plan('skip_all' => "This system cannot fork"); +} +else { + $b->plan('tests' => 2); +} + +my $pipe = IO::Pipe->new; +if (my $pid = fork) { + $pipe->reader; + my @output = <$pipe>; + $b->like($output[0], qr/ok 1/, "ok 1 from child"); + $b->like($output[1], qr/1\.\.1/, "got 1..1 from child"); + waitpid($pid, 0); +} +else { + Test::Stream::IOSets->hard_reset; + Test::Stream->clear; + $pipe->writer; + my $pipe_fd = $pipe->fileno; + close STDOUT; + open(STDOUT, ">&$pipe_fd"); + my $b = Test::Builder->create(shared_stream => 1); + $b->reset; + $b->no_plan; + $b->ok(1); + + exit 0; +} + +=pod +#actual +1..2 +ok 1 +1..1 +ok 1 +ok 2 +#expected +1..2 +ok 1 +ok 2 +=cut diff --git a/cpan/Test-Simple/t/Legacy/Builder/has_plan.t b/cpan/Test-Simple/t/Legacy/Builder/has_plan.t new file mode 100644 index 0000000000..d0be86a97a --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/has_plan.t @@ -0,0 +1,23 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib'); + } +} + +use strict; +use Test::Builder; + +my $unplanned; + +BEGIN { + $unplanned = 'oops'; + $unplanned = Test::Builder->new->has_plan; +}; + +use Test::More tests => 2; + +is($unplanned, undef, 'no plan yet defined'); +is(Test::Builder->new->has_plan, 2, 'has fixed plan'); diff --git a/cpan/Test-Simple/t/Legacy/Builder/has_plan2.t b/cpan/Test-Simple/t/Legacy/Builder/has_plan2.t new file mode 100644 index 0000000000..e13ea4af94 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/has_plan2.t @@ -0,0 +1,22 @@ +#!/usr/bin/perl -w + +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"; + } +} + +use strict; +use Test::Builder; + +plan 'no_plan'; +is(Test::Builder->new->has_plan, 'no_plan', 'has no_plan'); diff --git a/cpan/Test-Simple/t/Legacy/Builder/is_fh.t b/cpan/Test-Simple/t/Legacy/Builder/is_fh.t new file mode 100644 index 0000000000..f7a5f1a80d --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/is_fh.t @@ -0,0 +1,48 @@ +#!/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 => 11; +use TieOut; + +ok( !Test::Builder->is_fh("foo"), 'string is not a filehandle' ); +ok( !Test::Builder->is_fh(''), 'empty string' ); +ok( !Test::Builder->is_fh(undef), 'undef' ); + +ok( open(FILE, '>foo') ); +END { close FILE; 1 while unlink 'foo' } + +ok( Test::Builder->is_fh(*FILE) ); +ok( Test::Builder->is_fh(\*FILE) ); +ok( Test::Builder->is_fh(*FILE{IO}) ); + +tie *OUT, 'TieOut'; +ok( Test::Builder->is_fh(*OUT) ); +ok( Test::Builder->is_fh(\*OUT) ); + +SKIP: { + skip "*TIED_HANDLE{IO} doesn't work in this perl", 1 + unless defined *OUT{IO}; + ok( Test::Builder->is_fh(*OUT{IO}) ); +} + + +package Lying::isa; + +sub isa { + my $self = shift; + my $parent = shift; + + return 1 if $parent eq 'IO::Handle'; +} + +::ok( Test::Builder->is_fh(bless {}, "Lying::isa")); diff --git a/cpan/Test-Simple/t/Legacy/Builder/is_passing.t b/cpan/Test-Simple/t/Legacy/Builder/is_passing.t new file mode 100644 index 0000000000..d335aada57 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/is_passing.t @@ -0,0 +1,106 @@ +#!/usr/bin/perl -w + +use strict; +use lib 't/lib'; + +# We're going to need to override exit() later +BEGIN { + *CORE::GLOBAL::exit = sub(;$) { + my $status = @_ ? 0 : shift; + CORE::exit $status; + }; +} + +use Test::More; +use Test::Builder; +use Test::Builder::NoOutput; + +{ + my $tb = Test::Builder::NoOutput->create; + ok $tb->is_passing, "a fresh TB object is passing"; + + $tb->ok(1); + ok $tb->is_passing, " still passing after a test"; + + $tb->ok(0); + ok !$tb->is_passing, " not passing after a failing test"; + + $tb->ok(1); + ok !$tb->is_passing, " a passing test doesn't resurrect it"; + + $tb->done_testing(3); + ok !$tb->is_passing, " a successful plan doesn't help either"; +} + + +# See if is_passing() notices a plan overrun +{ + my $tb = Test::Builder::NoOutput->create; + $tb->plan( tests => 1 ); + $tb->ok(1); + ok $tb->is_passing, "Passing with a plan"; + + $tb->ok(1); + ok !$tb->is_passing, " passing test, but it overran the plan"; +} + + +# is_passing() vs no_plan +{ + my $tb = Test::Builder::NoOutput->create; + $tb->plan( "no_plan" ); + ok $tb->is_passing, "Passing with no_plan"; + + $tb->ok(1); + ok $tb->is_passing, " still passing after a test"; + + $tb->ok(1); + ok $tb->is_passing, " and another test"; + + $tb->_ending; + ok $tb->is_passing, " and after the ending"; +} + + +# is_passing() vs skip_all +{ + my $tb = Test::Builder::NoOutput->create; + + { + no warnings 'redefine'; + local *CORE::GLOBAL::exit = sub { + return 1; + }; + $tb->plan( "skip_all" ); + } + ok $tb->is_passing, "Passing with skip_all"; +} + + +# is_passing() vs done_testing(#) +{ + my $tb = Test::Builder::NoOutput->create; + $tb->ok(1); + $tb->done_testing(2); + ok !$tb->is_passing, "All tests passed but done_testing() does not match"; +} + + +# is_passing() with no tests run vs done_testing() +{ + my $tb = Test::Builder::NoOutput->create; + $tb->done_testing(); + ok !$tb->is_passing, "No tests run with done_testing()"; +} + + +# is_passing() with no tests run vs done_testing() +{ + my $tb = Test::Builder::NoOutput->create; + $tb->ok(1); + $tb->done_testing(); + ok $tb->is_passing, "All tests passed with done_testing()"; +} + + +done_testing(); diff --git a/cpan/Test-Simple/t/Legacy/Builder/maybe_regex.t b/cpan/Test-Simple/t/Legacy/Builder/maybe_regex.t new file mode 100644 index 0000000000..fd8b8d06ed --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/maybe_regex.t @@ -0,0 +1,60 @@ +#!/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 => 16; + +use Test::Builder; +my $Test = Test::Builder->new; + +my $r = $Test->maybe_regex(qr/^FOO$/i); +ok(defined $r, 'qr// detected'); +ok(('foo' =~ /$r/), 'qr// good match'); +ok(('bar' !~ /$r/), 'qr// bad match'); + +SKIP: { + skip "blessed regex checker added in 5.10", 3 if $] < 5.010; + + my $obj = bless qr/foo/, 'Wibble'; + my $re = $Test->maybe_regex($obj); + ok( defined $re, "blessed regex detected" ); + ok( ('foo' =~ /$re/), 'blessed qr/foo/ good match' ); + ok( ('bar' !~ /$re/), 'blessed qr/foo/ bad math' ); +} + +{ + my $r = $Test->maybe_regex('/^BAR$/i'); + ok(defined $r, '"//" detected'); + ok(('bar' =~ m/$r/), '"//" good match'); + ok(('foo' !~ m/$r/), '"//" bad match'); +}; + +{ + my $r = $Test->maybe_regex('not a regex'); + ok(!defined $r, 'non-regex detected'); +}; + + +{ + my $r = $Test->maybe_regex('/0/'); + ok(defined $r, 'non-regex detected'); + ok(('f00' =~ m/$r/), '"//" good match'); + ok(('b4r' !~ m/$r/), '"//" bad match'); +}; + + +{ + my $r = $Test->maybe_regex('m,foo,i'); + ok(defined $r, 'm,, detected'); + ok(('fOO' =~ m/$r/), '"//" good match'); + ok(('bar' !~ m/$r/), '"//" bad match'); +}; diff --git a/cpan/Test-Simple/t/Legacy/Builder/no_diag.t b/cpan/Test-Simple/t/Legacy/Builder/no_diag.t new file mode 100644 index 0000000000..6fa538a82e --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/no_diag.t @@ -0,0 +1,8 @@ +#!/usr/bin/perl -w + +use Test::More 'no_diag', tests => 2; + +pass('foo'); +diag('This should not be displayed'); + +is(Test::More->builder->no_diag, 1); diff --git a/cpan/Test-Simple/t/Legacy/Builder/no_ending.t b/cpan/Test-Simple/t/Legacy/Builder/no_ending.t new file mode 100644 index 0000000000..03e0cc489d --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/no_ending.t @@ -0,0 +1,21 @@ +use Test::Builder; + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +BEGIN { + my $t = Test::Builder->new; + $t->no_ending(1); +} + +use Test::More tests => 3; + +# Normally, Test::More would yell that we ran too few tests, but we +# suppressed the ending diagnostics. +pass; +print "ok 2\n"; +print "ok 3\n"; diff --git a/cpan/Test-Simple/t/Legacy/Builder/no_header.t b/cpan/Test-Simple/t/Legacy/Builder/no_header.t new file mode 100644 index 0000000000..93e6bec34c --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/no_header.t @@ -0,0 +1,21 @@ +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::Builder; + +# STDOUT must be unbuffered else our prints might come out after +# Test::More's. +$| = 1; + +BEGIN { + Test::Builder->new->no_header(1); +} + +use Test::More tests => 1; + +print "1..1\n"; +pass; diff --git a/cpan/Test-Simple/t/Legacy/Builder/no_plan_at_all.t b/cpan/Test-Simple/t/Legacy/Builder/no_plan_at_all.t new file mode 100644 index 0000000000..64a0e19476 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/no_plan_at_all.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl -w + +# Test what happens when no plan is declared and done_testing() is not seen + +use strict; +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::Builder; +use Test::Builder::NoOutput; + +my $Test = Test::Builder->new; +$Test->level(0); +$Test->plan( tests => 1 ); + +my $tb = Test::Builder::NoOutput->create; + +{ + $tb->level(0); + $tb->ok(1, "just a test"); + $tb->ok(1, " and another"); + $tb->_ending; +} + +$Test->is_eq($tb->read, <<'END', "proper behavior when no plan is seen"); +ok 1 - just a test +ok 2 - and another +# Tests were run but no plan was declared and done_testing() was not seen. +END diff --git a/cpan/Test-Simple/t/Legacy/Builder/ok_obj.t b/cpan/Test-Simple/t/Legacy/Builder/ok_obj.t new file mode 100644 index 0000000000..8678dbff8d --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/ok_obj.t @@ -0,0 +1,29 @@ +#!/usr/bin/perl -w + +# Testing to make sure Test::Builder doesn't accidentally store objects +# passed in as test arguments. + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::More tests => 4; + +package Foo; +my $destroyed = 0; +sub new { bless {}, shift } + +sub DESTROY { + $destroyed++; +} + +package main; + +for (1..3) { + ok(my $foo = Foo->new, 'created Foo object'); +} +is $destroyed, 3, "DESTROY called 3 times"; + diff --git a/cpan/Test-Simple/t/Legacy/Builder/output.t b/cpan/Test-Simple/t/Legacy/Builder/output.t new file mode 100644 index 0000000000..77e0e0bbb3 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/output.t @@ -0,0 +1,113 @@ +#!perl -w + +use strict; + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} +chdir 't'; + +use Test::Builder; + +# The real Test::Builder +my $Test = Test::Builder->new; +$Test->plan( tests => 6 ); + + +# The one we're going to test. +my $tb = Test::Builder->create(); + +my $tmpfile = 'foo.tmp'; +END { 1 while unlink($tmpfile) } + +# Test output to a file +{ + my $out = $tb->output($tmpfile); + $Test->ok( defined $out ); + + print $out "hi!\n"; + close *$out; + + undef $out; + open(IN, $tmpfile) or die $!; + chomp(my $line = <IN>); + close IN; + + $Test->is_eq($line, 'hi!'); +} + + +# Test output to a filehandle +{ + open(FOO, ">>$tmpfile") or die $!; + my $out = $tb->output(\*FOO); + my $old = select *$out; + print "Hello!\n"; + close *$out; + undef $out; + select $old; + open(IN, $tmpfile) or die $!; + my @lines = <IN>; + close IN; + + $Test->like($lines[1], qr/Hello!/); +} + + +# Test output to a scalar ref +{ + my $scalar = ''; + my $out = $tb->output(\$scalar); + + print $out "Hey hey hey!\n"; + $Test->is_eq($scalar, "Hey hey hey!\n"); +} + + +# Test we can output to the same scalar ref +{ + my $scalar = ''; + my $out = $tb->output(\$scalar); + my $err = $tb->failure_output(\$scalar); + + print $out "To output "; + print $err "and beyond!"; + + $Test->is_eq($scalar, "To output and beyond!", "One scalar, two filehandles"); +} + + +# Ensure stray newline in name escaping works. +{ + my $fakeout = ''; + my $out = $tb->output(\$fakeout); + $tb->exported_to(__PACKAGE__); + $tb->no_ending(1); + $tb->plan(tests => 5); + + $tb->ok(1, "ok"); + $tb->ok(1, "ok\n"); + $tb->ok(1, "ok, like\nok"); + $tb->skip("wibble\nmoof"); + $tb->todo_skip("todo\nskip\n"); + + $Test->is_eq( $fakeout, <<OUTPUT ) || print STDERR $fakeout; +1..5 +ok 1 - ok +ok 2 - ok +# +ok 3 - ok, like +# ok +ok 4 # skip wibble +# moof +not ok 5 # TODO & SKIP todo +# skip +# +OUTPUT +} diff --git a/cpan/Test-Simple/t/Legacy/Builder/reset.t b/cpan/Test-Simple/t/Legacy/Builder/reset.t new file mode 100644 index 0000000000..fd11db71b2 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/reset.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w + +# Test Test::Builder->reset; + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} +chdir 't'; + +use Test::Builder; +my $Test = Test::Builder->new; +my $tb = Test::Builder->create; + +# We'll need this later to know the outputs were reset +my %Original_Output; +$Original_Output{$_} = $tb->$_ for qw(output failure_output todo_output); + +# Alter the state of Test::Builder as much as possible. +my $output = ''; +$tb->output(\$output); +$tb->failure_output(\$output); +$tb->todo_output(\$output); + +$tb->plan(tests => 14); +$tb->level(0); + +$tb->ok(1, "Running a test to alter TB's state"); + +# This won't print since we just sent output off to oblivion. +$tb->ok(0, "And a failure for fun"); + +$Test::Builder::Level = 3; + +$tb->exported_to('Foofer'); + +$tb->use_numbers(0); +$tb->no_header(1); +$tb->no_ending(1); + +$tb->done_testing; # make sure done_testing gets reset + +# Now reset it. +$tb->reset; + + +# Test the state of the reset builder +$Test->ok( !defined $tb->exported_to, 'exported_to' ); +$Test->is_eq( $tb->expected_tests, 0, 'expected_tests' ); +$Test->is_eq( $tb->level, 1, 'level' ); +$Test->is_eq( $tb->use_numbers, 1, 'use_numbers' ); +$Test->is_eq( $tb->no_header, 0, 'no_header' ); +$Test->is_eq( $tb->current_test, 0, 'current_test' ); +$Test->is_eq( scalar $tb->summary, 0, 'summary' ); +$Test->is_eq( scalar $tb->details, 0, 'details' ); +$Test->is_eq( fileno $tb->output, + fileno $Original_Output{output}, 'output' ); +$Test->is_eq( fileno $tb->failure_output, + fileno $Original_Output{failure_output}, 'failure_output' ); +$Test->is_eq( fileno $tb->todo_output, + fileno $Original_Output{todo_output}, 'todo_output' ); + +# The reset Test::Builder will take over from here. +$Test->no_ending(1); + +$tb->current_test($Test->current_test); +$tb->level(0); +$tb->ok(1, 'final test to make sure output was reset'); + +$tb->done_testing; diff --git a/cpan/Test-Simple/t/Legacy/Builder/reset_outputs.t b/cpan/Test-Simple/t/Legacy/Builder/reset_outputs.t new file mode 100644 index 0000000000..b199128ad3 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Builder/reset_outputs.t @@ -0,0 +1,35 @@ +#!perl -w + +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/cpan/Test-Simple/t/Legacy/More.t b/cpan/Test-Simple/t/Legacy/More.t new file mode 100644 index 0000000000..b4f680bb31 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/More.t @@ -0,0 +1,185 @@ +#!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 => 54; +use Test::Builder; + +# 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'); +{ + local %Bar::; + local @Foo::ISA = 'Bar'; + isa_ok( "Foo", "Bar" ); +} + + +# 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] } + ); + + +# rt.cpan.org 53469 is_deeply with regexes +is_deeply( qr/a/, qr/a/, "same regex" ); + + +# These two tests must remain at the end. +is( $@, $Err, '$@ untouched' ); +cmp_ok( $!, '==', $Errno, '$! untouched' ); diff --git a/cpan/Test-Simple/t/Legacy/PerlIO.t b/cpan/Test-Simple/t/Legacy/PerlIO.t new file mode 100644 index 0000000000..84ba649b37 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/PerlIO.t @@ -0,0 +1,11 @@ +use Test::More; +require PerlIO; + +my $ok = 1; +my %counts; +for my $layer (PerlIO::get_layers(Test::Stream->shared->io_sets->{legacy}->[0])) { + my $dup = $counts{$layer}++; + ok(!$dup, "No IO layer duplication '$layer'"); +} + +done_testing; diff --git a/cpan/Test-Simple/t/Legacy/Simple/load.t b/cpan/Test-Simple/t/Legacy/Simple/load.t new file mode 100644 index 0000000000..938569a5b8 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Simple/load.t @@ -0,0 +1,13 @@ +#!/usr/bin/perl + +# Because I broke "use Test::Simple", here's a test + +use strict; +use warnings; + +use Test::Simple; + +print <<END; +1..1 +ok 1 - use Test::Simple with no arguments +END diff --git a/cpan/Test-Simple/t/Legacy/TestTester/auto.t b/cpan/Test-Simple/t/Legacy/TestTester/auto.t new file mode 100644 index 0000000000..45510f3f06 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/TestTester/auto.t @@ -0,0 +1,32 @@ +use strict; +use warnings; + +BEGIN { + if ($ENV{PERL_CORE}) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::Tester tests => 4; + +use SmallTest; + +use MyTest; + +{ + my ($prem, @results) = run_tests(sub { MyTest::ok(1, "run pass") }); + + is_eq($results[0]->{name}, "run pass"); + is_num($results[0]->{ok}, 1); +} + +{ + my ($prem, @results) = run_tests(sub { MyTest::ok(0, "run fail") }); + + is_eq($results[0]->{name}, "run fail"); + is_num($results[0]->{ok}, 0); +} diff --git a/cpan/Test-Simple/t/Legacy/TestTester/check_tests.t b/cpan/Test-Simple/t/Legacy/TestTester/check_tests.t new file mode 100644 index 0000000000..96b8470329 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/TestTester/check_tests.t @@ -0,0 +1,116 @@ +use strict; + +use Test::Tester; + +use Data::Dumper qw(Dumper); + +my $test = Test::Builder->new; +$test->plan(tests => 105); + +my $cap; + +$cap = $test; + +my @tests = ( + [ + 'pass', + '$cap->ok(1, "pass");', + { + name => "pass", + ok => 1, + actual_ok => 1, + reason => "", + type => "", + diag => "", + depth => 0, + }, + ], + [ + 'pass diag', + '$cap->ok(1, "pass diag"); + $cap->diag("pass diag1"); + $cap->diag("pass diag2");', + { + name => "pass diag", + ok => 1, + actual_ok => 1, + reason => "", + type => "", + diag => "pass diag1\npass diag2\n", + depth => 0, + }, + ], + [ + 'pass diag no \\n', + '$cap->ok(1, "pass diag"); + $cap->diag("pass diag1"); + $cap->diag("pass diag2");', + { + name => "pass diag", + ok => 1, + actual_ok => 1, + reason => "", + type => "", + diag => "pass diag1\npass diag2", + depth => 0, + }, + ], + [ + 'fail', + '$cap->ok(0, "fail"); + $cap->diag("fail diag");', + { + name => "fail", + ok => 0, + actual_ok => 0, + reason => "", + type => "", + diag => "fail diag\n", + depth => 0, + }, + ], + [ + 'skip', + '$cap->skip("just because");', + { + name => "", + ok => 1, + actual_ok => 1, + reason => "just because", + type => "skip", + diag => "", + depth => 0, + }, + ], + [ + 'todo_skip', + '$cap->todo_skip("why not");', + { + name => "", + ok => 1, + actual_ok => 0, + reason => "why not", + type => "todo_skip", + diag => "", + depth => 0, + }, + ], +); + +my $big_code = ""; +my @big_expect; + +foreach my $test (@tests) { + my ($name, $code, $expect) = @$test; + + $big_code .= "$code\n"; + push(@big_expect, $expect); + + my $test_sub = eval "sub {$code}"; + + check_test($test_sub, $expect, $name); +} + +my $big_test_sub = eval "sub {$big_code}"; + +check_tests($big_test_sub, \@big_expect, "run all"); diff --git a/cpan/Test-Simple/t/Legacy/TestTester/depth.t b/cpan/Test-Simple/t/Legacy/TestTester/depth.t new file mode 100644 index 0000000000..53ba7e0779 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/TestTester/depth.t @@ -0,0 +1,39 @@ +use strict; +use warnings; + +BEGIN { + if ($ENV{PERL_CORE}) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::Tester; + +use MyTest; + +my $test = Test::Builder->new; +$test->plan(tests => 2); + +sub deeper +{ + MyTest::ok(1); +} + +{ + + my @results = run_tests( + sub { + MyTest::ok(1); + deeper(); + } + ); + + local $Test::Builder::Level = 0; + $test->is_num($results[1]->{depth}, 1, "depth 1"); + $test->is_num($results[2]->{depth}, 2, "deeper"); +} + diff --git a/cpan/Test-Simple/t/Legacy/TestTester/is_bug.t b/cpan/Test-Simple/t/Legacy/TestTester/is_bug.t new file mode 100644 index 0000000000..64642fca2a --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/TestTester/is_bug.t @@ -0,0 +1,31 @@ +use strict; +use warnings; +use Test::Tester; +use Test::More; + +check_test( + sub { is "Foo", "Foo" }, + {ok => 1}, +); + +check_test( + sub { is "Bar", "Bar" }, + {ok => 1}, +); + +check_test( + sub { is "Baz", "Quux" }, + {ok => 0}, +); + +check_test( + sub { like "Baz", qr/uhg/ }, + {ok => 0}, +); + +check_test( + sub { like "Baz", qr/a/ }, + {ok => 1}, +); + +done_testing(); diff --git a/cpan/Test-Simple/t/Legacy/TestTester/run_test.t b/cpan/Test-Simple/t/Legacy/TestTester/run_test.t new file mode 100644 index 0000000000..6b1464c358 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/TestTester/run_test.t @@ -0,0 +1,145 @@ +use strict; + +use Test::Tester; + +use Data::Dumper qw(Dumper); + +my $test = Test::Builder->new; +$test->plan(tests => 54); + +my $cap; + +{ + $cap = $test; + my ($prem, @results) = run_tests( + sub {$cap->ok(1, "run pass")} + ); + + local $Test::Builder::Level = 0; + + $test->is_eq($prem, "", "run pass no prem"); + $test->is_num(scalar (@results), 1, "run pass result count"); + + my $res = $results[0]; + + $test->is_eq($res->{name}, "run pass", "run pass name"); + $test->is_eq($res->{ok}, 1, "run pass ok"); + $test->is_eq($res->{actual_ok}, 1, "run pass actual_ok"); + $test->is_eq($res->{reason}, "", "run pass reason"); + $test->is_eq($res->{type}, "", "run pass type"); + $test->is_eq($res->{diag}, "", "run pass diag"); + $test->is_num($res->{depth}, 0, "run pass depth"); +} + +{ + my ($prem, @results) = run_tests( + sub {$cap->ok(0, "run fail")} + ); + + local $Test::Builder::Level = 0; + + $test->is_eq($prem, "", "run fail no prem"); + $test->is_num(scalar (@results), 1, "run fail result count"); + + my $res = $results[0]; + + $test->is_eq($res->{name}, "run fail", "run fail name"); + $test->is_eq($res->{actual_ok}, 0, "run fail actual_ok"); + $test->is_eq($res->{ok}, 0, "run fail ok"); + $test->is_eq($res->{reason}, "", "run fail reason"); + $test->is_eq($res->{type}, "", "run fail type"); + $test->is_eq($res->{diag}, "", "run fail diag"); + $test->is_num($res->{depth}, 0, "run fail depth"); +} + +{ + my ($prem, @results) = run_tests( + sub {$cap->skip("just because")} + ); + + local $Test::Builder::Level = 0; + + $test->is_eq($prem, "", "skip no prem"); + $test->is_num(scalar (@results), 1, "skip result count"); + + my $res = $results[0]; + + $test->is_eq($res->{name}, "", "skip name"); + $test->is_eq($res->{actual_ok}, 1, "skip actual_ok"); + $test->is_eq($res->{ok}, 1, "skip ok"); + $test->is_eq($res->{reason}, "just because", "skip reason"); + $test->is_eq($res->{type}, "skip", "skip type"); + $test->is_eq($res->{diag}, "", "skip diag"); + $test->is_num($res->{depth}, 0, "skip depth"); +} + +{ + my ($prem, @results) = run_tests( + sub {$cap->todo_skip("just because")} + ); + + local $Test::Builder::Level = 0; + + $test->is_eq($prem, "", "todo_skip no prem"); + $test->is_num(scalar (@results), 1, "todo_skip result count"); + + my $res = $results[0]; + + $test->is_eq($res->{name}, "", "todo_skip name"); + $test->is_eq($res->{actual_ok}, 0, "todo_skip actual_ok"); + $test->is_eq($res->{ok}, 1, "todo_skip ok"); + $test->is_eq($res->{reason}, "just because", "todo_skip reason"); + $test->is_eq($res->{type}, "todo_skip", "todo_skip type"); + $test->is_eq($res->{diag}, "", "todo_skip diag"); + $test->is_num($res->{depth}, 0, "todo_skip depth"); +} + +{ + my ($prem, @results) = run_tests( + sub {$cap->diag("run diag")} + ); + + local $Test::Builder::Level = 0; + + $test->is_eq($prem, "run diag\n", "run diag prem"); + $test->is_num(scalar (@results), 0, "run diag result count"); +} + +{ + my ($prem, @results) = run_tests( + sub { + $cap->ok(1, "multi pass"); + $cap->diag("multi pass diag1"); + $cap->diag("multi pass diag2"); + $cap->ok(0, "multi fail"); + $cap->diag("multi fail diag"); + } + ); + + local $Test::Builder::Level = 0; + + $test->is_eq($prem, "", "run multi no prem"); + $test->is_num(scalar (@results), 2, "run multi result count"); + + my $res_pass = $results[0]; + + $test->is_eq($res_pass->{name}, "multi pass", "run multi pass name"); + $test->is_eq($res_pass->{actual_ok}, 1, "run multi pass actual_ok"); + $test->is_eq($res_pass->{ok}, 1, "run multi pass ok"); + $test->is_eq($res_pass->{reason}, "", "run multi pass reason"); + $test->is_eq($res_pass->{type}, "", "run multi pass type"); + $test->is_eq($res_pass->{diag}, "multi pass diag1\nmulti pass diag2\n", + "run multi pass diag"); + $test->is_num($res_pass->{depth}, 0, "run multi pass depth"); + + my $res_fail = $results[1]; + + $test->is_eq($res_fail->{name}, "multi fail", "run multi fail name"); + $test->is_eq($res_pass->{actual_ok}, 1, "run multi fail actual_ok"); + $test->is_eq($res_fail->{ok}, 0, "run multi fail ok"); + $test->is_eq($res_pass->{reason}, "", "run multi fail reason"); + $test->is_eq($res_pass->{type}, "", "run multi fail type"); + $test->is_eq($res_fail->{diag}, "multi fail diag\n", "run multi fail diag"); + $test->is_num($res_pass->{depth}, 0, "run multi fail depth"); +} + diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_01basic.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_01basic.t new file mode 100644 index 0000000000..1b4b556d3f --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_01basic.t @@ -0,0 +1,59 @@ +#!/usr/bin/perl + +use Test::Builder::Tester tests => 10; +use Test::More; + +ok(1,"This is a basic test"); + +test_out("ok 1 - tested"); +ok(1,"tested"); +test_test("captured okay on basic"); + +test_out("ok 1 - tested"); +ok(1,"tested"); +test_test("captured okay again without changing number"); + +ok(1,"test unrelated to Test::Builder::Tester"); + +test_out("ok 1 - one"); +test_out("ok 2 - two"); +ok(1,"one"); +ok(2,"two"); +test_test("multiple tests"); + +test_out(qr/ok 1 - tested\n/); +ok(1,"tested"); +test_test("regexp matching"); + +test_out("not ok 1 - should fail"); +test_err("# Failed test ($0 at line 32)"); +test_err("# got: 'foo'"); +test_err("# expected: 'bar'"); +is("foo","bar","should fail"); +test_test("testing failing"); + + +test_out("not ok 1"); +test_out("not ok 2"); +test_fail(+2); +test_fail(+1); +fail(); fail(); +test_test("testing failing on the same line with no name"); + + +test_out("not ok 1 - name"); +test_out("not ok 2 - name"); +test_fail(+2); +test_fail(+1); +fail("name"); fail("name"); +test_test("testing failing on the same line with the same name"); + + +test_out("not ok 1 - name # TODO Something"); +test_out("# Failed (TODO) test ($0 at line 56)"); +TODO: { + local $TODO = "Something"; + fail("name"); +} +test_test("testing failing with todo"); + diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_02fhrestore.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_02fhrestore.t new file mode 100644 index 0000000000..c7826cdf1d --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_02fhrestore.t @@ -0,0 +1,58 @@ +#!/usr/bin/perl + +use Test::Builder::Tester tests => 4; +use Test::More; +use Symbol; + +# create temporary file handles that still point indirectly +# to the right place + +my $orig_o = gensym; +my $orig_t = gensym; +my $orig_f = gensym; + +tie *$orig_o, "My::Passthru", \*STDOUT; +tie *$orig_t, "My::Passthru", \*STDERR; +tie *$orig_f, "My::Passthru", \*STDERR; + +# redirect the file handles to somewhere else for a mo + +use Test::Builder; +my $t = Test::Builder->new(); + +$t->output($orig_o); +$t->failure_output($orig_f); +$t->todo_output($orig_t); + +# run a test + +test_out("ok 1 - tested"); +ok(1,"tested"); +test_test("standard test okay"); + +# now check that they were restored okay + +ok($orig_o == $t->output(), "output file reconnected"); +ok($orig_t == $t->todo_output(), "todo output file reconnected"); +ok($orig_f == $t->failure_output(), "failure output file reconnected"); + +##################################################################### + +package My::Passthru; + +sub PRINT { + my $self = shift; + my $handle = $self->[0]; + print $handle @_; +} + +sub TIEHANDLE { + my $class = shift; + my $self = [shift()]; + return bless $self, $class; +} + +sub READ {} +sub READLINE {} +sub GETC {} +sub FILENO {} diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_03die.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_03die.t new file mode 100644 index 0000000000..b9dba801eb --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_03die.t @@ -0,0 +1,12 @@ +#!/usr/bin/perl + +use Test::Builder::Tester tests => 1; +use Test::More; + +eval { + test_test("foo"); +}; +like($@, + "/Not testing\. You must declare output with a test function first\./", + "dies correctly on error"); + diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_04line_num.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_04line_num.t new file mode 100644 index 0000000000..9e8365acbf --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_04line_num.t @@ -0,0 +1,8 @@ +#!/usr/bin/perl + +use Test::More tests => 3; +use Test::Builder::Tester; + +is(line_num(),6,"normal line num"); +is(line_num(-1),6,"line number minus one"); +is(line_num(+2),10,"line number plus two"); diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_05faildiag.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_05faildiag.t new file mode 100644 index 0000000000..59ad721240 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_05faildiag.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +use Test::Builder::Tester tests => 5; +use Test::More; + +# test_fail + +test_out("not ok 1 - one"); +test_fail(+1); +ok(0,"one"); + +test_out("not ok 2 - two"); +test_fail(+2); + +ok(0,"two"); + +test_test("test fail"); + +test_fail(+2); +test_out("not ok 1 - one"); +ok(0,"one"); +test_test("test_fail first"); + +# test_diag + +use Test::Builder; +my $test = new Test::Builder; + +test_diag("this is a test string","so is this"); +$test->diag("this is a test string\n", "so is this\n"); +test_test("test diag"); + +test_diag("this is a test string","so is this"); +$test->diag("this is a test string\n"); +$test->diag("so is this\n"); +test_test("test diag multi line"); + +test_diag("this is a test string"); +test_diag("so is this"); +$test->diag("this is a test string\n"); +$test->diag("so is this\n"); +test_test("test diag multiple"); + + diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t new file mode 100644 index 0000000000..f68cba4e42 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t @@ -0,0 +1,120 @@ +#!/usr/bin/perl -w + +use Test::More tests => 8; +use Symbol; +use Test::Builder; +use Test::Builder::Tester; + +use strict; + +# argh! now we need to test the thing we're testing. Basically we need +# to pretty much reimplement the whole code again. This is very +# annoying but can't be avoided. And onwards with the cut and paste + +# My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING + +# create some private file handles +my $output_handle = gensym; +my $error_handle = gensym; + +# and tie them to this package +my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; +my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; + +# ooooh, use the test suite +my $t = Test::Builder->new; + +# remember the testing outputs +my $original_output_handle; +my $original_failure_handle; +my $original_todo_handle; +my $original_harness_env; +my $testing_num; + +sub start_testing +{ + # remember what the handles were set to + $original_output_handle = $t->output(); + $original_failure_handle = $t->failure_output(); + $original_todo_handle = $t->todo_output(); + $original_harness_env = $ENV{HARNESS_ACTIVE}; + + # switch out to our own handles + $t->output($output_handle); + $t->failure_output($error_handle); + $t->todo_output($error_handle); + + $ENV{HARNESS_ACTIVE} = 0; + + # clear the expected list + $out->reset(); + $err->reset(); + + # remember that we're testing + $testing_num = $t->current_test; + $t->current_test(0); +} + +# each test test is actually two tests. This is bad and wrong +# but makes blood come out of my ears if I don't at least simplify +# it a little this way + +sub my_test_test +{ + my $text = shift; + local $^W = 0; + + # reset the outputs + $t->output($original_output_handle); + $t->failure_output($original_failure_handle); + $t->todo_output($original_todo_handle); + $ENV{HARNESS_ACTIVE} = $original_harness_env; + + # reset the number of tests + $t->current_test($testing_num); + + # check we got the same values + my $got; + my $wanted; + + # stdout + $t->ok($out->check, "STDOUT $text"); + + # stderr + $t->ok($err->check, "STDERR $text"); +} + +#################################################################### +# Meta meta tests +#################################################################### + +# this is a quick test to check the hack that I've just implemented +# actually does a cut down version of Test::Builder::Tester + +start_testing(); +$out->expect("ok 1 - foo"); +pass("foo"); +my_test_test("basic meta meta test"); + +start_testing(); +$out->expect("not ok 1 - foo"); +$err->expect("# Failed test ($0 at line ".line_num(+1).")"); +fail("foo"); +my_test_test("basic meta meta test 2"); + +start_testing(); +$out->expect("ok 1 - bar"); +test_out("ok 1 - foo"); +pass("foo"); +test_test("bar"); +my_test_test("meta meta test with tbt"); + +start_testing(); +$out->expect("ok 1 - bar"); +test_out("not ok 1 - foo"); +test_err("# Failed test ($0 at line ".line_num(+1).")"); +fail("foo"); +test_test("bar"); +my_test_test("meta meta test with tbt2 "); + +#################################################################### diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t new file mode 100644 index 0000000000..0e322128dc --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t @@ -0,0 +1,215 @@ +#!/usr/bin/perl -w + +use Test::More tests => 18; +use Symbol; +use Test::Builder; +use Test::Builder::Tester; + +use strict; + +# argh! now we need to test the thing we're testing. Basically we need +# to pretty much reimplement the whole code again. This is very +# annoying but can't be avoided. And onwards with the cut and paste + +# My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING + +# create some private file handles +my $output_handle = gensym; +my $error_handle = gensym; + +# and tie them to this package +my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; +my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; + +# ooooh, use the test suite +my $t = Test::Builder->new; + +# remember the testing outputs +my $original_output_handle; +my $original_failure_handle; +my $original_todo_handle; +my $testing_num; +my $original_harness_env; + +sub start_testing +{ + # remember what the handles were set to + $original_output_handle = $t->output(); + $original_failure_handle = $t->failure_output(); + $original_todo_handle = $t->todo_output(); + $original_harness_env = $ENV{HARNESS_ACTIVE}; + + # switch out to our own handles + $t->output($output_handle); + $t->failure_output($error_handle); + $t->todo_output($error_handle); + + $ENV{HARNESS_ACTIVE} = 0; + + # clear the expected list + $out->reset(); + $err->reset(); + + # remember that we're testing + $testing_num = $t->current_test; + $t->current_test(0); +} + +# each test test is actually two tests. This is bad and wrong +# but makes blood come out of my ears if I don't at least simplify +# it a little this way + +sub my_test_test +{ + my $text = shift; + local $^W = 0; + + # reset the outputs + $t->output($original_output_handle); + $t->failure_output($original_failure_handle); + $t->todo_output($original_todo_handle); + $ENV{HARNESS_ACTIVE} = $original_harness_env; + + # reset the number of tests + $t->current_test($testing_num); + + # check we got the same values + my $got; + my $wanted; + + # stdout + $t->ok($out->check, "STDOUT $text"); + + # stderr + $t->ok($err->check, "STDERR $text"); +} + +#################################################################### +# Meta meta tests +#################################################################### + +# this is a quick test to check the hack that I've just implemented +# actually does a cut down version of Test::Builder::Tester + +start_testing(); +$out->expect("ok 1 - foo"); +pass("foo"); +my_test_test("basic meta meta test"); + +start_testing(); +$out->expect("not ok 1 - foo"); +$err->expect("# Failed test ($0 at line ".line_num(+1).")"); +fail("foo"); +my_test_test("basic meta meta test 2"); + +start_testing(); +$out->expect("ok 1 - bar"); +test_out("ok 1 - foo"); +pass("foo"); +test_test("bar"); +my_test_test("meta meta test with tbt"); + +start_testing(); +$out->expect("ok 1 - bar"); +test_out("not ok 1 - foo"); +test_err("# Failed test ($0 at line ".line_num(+1).")"); +fail("foo"); +test_test("bar"); +my_test_test("meta meta test with tbt2 "); + +#################################################################### +# Actual meta tests +#################################################################### + +# set up the outer wrapper again +start_testing(); +$out->expect("ok 1 - bar"); + +# set up what the inner wrapper expects +test_out("ok 1 - foo"); + +# the actual test function that we are testing +ok("1","foo"); + +# test the name +test_test(name => "bar"); + +# check that passed +my_test_test("meta test name"); + +#################################################################### + +# set up the outer wrapper again +start_testing(); +$out->expect("ok 1 - bar"); + +# set up what the inner wrapper expects +test_out("ok 1 - foo"); + +# the actual test function that we are testing +ok("1","foo"); + +# test the name +test_test(title => "bar"); + +# check that passed +my_test_test("meta test title"); + +#################################################################### + +# set up the outer wrapper again +start_testing(); +$out->expect("ok 1 - bar"); + +# set up what the inner wrapper expects +test_out("ok 1 - foo"); + +# the actual test function that we are testing +ok("1","foo"); + +# test the name +test_test(label => "bar"); + +# check that passed +my_test_test("meta test title"); + +#################################################################### + +# set up the outer wrapper again +start_testing(); +$out->expect("ok 1 - bar"); + +# set up what the inner wrapper expects +test_out("not ok 1 - foo this is wrong"); +test_fail(+3); + +# the actual test function that we are testing +ok("0","foo"); + +# test that we got what we expect, ignoring our is wrong +test_test(skip_out => 1, name => "bar"); + +# check that that passed +my_test_test("meta test skip_out"); + +#################################################################### + +# set up the outer wrapper again +start_testing(); +$out->expect("ok 1 - bar"); + +# set up what the inner wrapper expects +test_out("not ok 1 - foo"); +test_err("this is wrong"); + +# the actual test function that we are testing +ok("0","foo"); + +# test that we got what we expect, ignoring err is wrong +test_test(skip_err => 1, name => "bar"); + +# diagnostics failing out +# check that that passed +my_test_test("meta test skip_err"); + +#################################################################### diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_08subtest.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_08subtest.t new file mode 100644 index 0000000000..6ec508f247 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_08subtest.t @@ -0,0 +1,16 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::Builder::Tester tests => 1; +use Test::More; + +subtest 'foo' => sub { + plan tests => 1; + + test_out("not ok 1 - foo"); + test_fail(+1); + fail("foo"); + test_test("fail works"); +}; diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_09do.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_09do.t new file mode 100644 index 0000000000..a0c8b8e2e5 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_09do.t @@ -0,0 +1,21 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::Builder::Tester tests => 3; +use Test::More; +use File::Basename qw(dirname); +use File::Spec qw(); + +my $file = File::Spec->join(dirname(__FILE__), 'tbt_09do_script.pl'); +my $done = do $file; +ok(defined($done), 'do succeeded') or do { + if ($@) { + diag qq( \$@ is '$@'\n); + } elsif ($!) { + diag qq( \$! is '$!'\n); + } else { + diag qq( file's last statement returned undef: $file) + } +}; diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_09do_script.pl b/cpan/Test-Simple/t/Legacy/Tester/tbt_09do_script.pl new file mode 100644 index 0000000000..590a03b085 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_09do_script.pl @@ -0,0 +1,13 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +isnt($0, __FILE__, 'code is not executing directly'); + +test_out("not ok 1 - one"); +test_fail(+1); +ok(0,"one"); +test_test('test_fail caught fail message inside a do'); + +1; diff --git a/cpan/Test-Simple/t/Legacy/bad_plan.t b/cpan/Test-Simple/t/Legacy/bad_plan.t new file mode 100644 index 0000000000..80e0e65bca --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/bad_plan.t @@ -0,0 +1,23 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::Builder; +my $Test = Test::Builder->new; +$Test->plan( tests => 2 ); +$Test->level(0); + +my $tb = Test::Builder->create; + +eval { $tb->plan(7); }; +$Test->like( $@, qr/^plan\(\) doesn't understand 7/, 'bad plan()' ) || + print STDERR "# $@"; + +eval { $tb->plan(wibble => 7); }; +$Test->like( $@, qr/^plan\(\) doesn't understand wibble 7/, 'bad plan()' ) || + print STDERR "# $@"; diff --git a/cpan/Test-Simple/t/Legacy/bail_out.t b/cpan/Test-Simple/t/Legacy/bail_out.t new file mode 100644 index 0000000000..5cdc1f9969 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/bail_out.t @@ -0,0 +1,43 @@ +#!/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; + +my $output; +my $TB = Test::More->builder; +$TB->output(\$output); + +my $Test = Test::Builder->create; +$Test->level(0); + +$Test->plan(tests => 3); + +plan tests => 4; + +BAIL_OUT("ROCKS FALL! EVERYONE DIES!"); + + +$Test->is_eq( $output, <<'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/cpan/Test-Simple/t/Legacy/buffer.t b/cpan/Test-Simple/t/Legacy/buffer.t new file mode 100644 index 0000000000..6039e4a6f7 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/buffer.t @@ -0,0 +1,22 @@ +#!/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/cpan/Test-Simple/t/Legacy/c_flag.t b/cpan/Test-Simple/t/Legacy/c_flag.t new file mode 100644 index 0000000000..a33963415e --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/c_flag.t @@ -0,0 +1,21 @@ +#!/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/cpan/Test-Simple/t/Legacy/circular_data.t b/cpan/Test-Simple/t/Legacy/circular_data.t new file mode 100644 index 0000000000..15eb6d406f --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/circular_data.t @@ -0,0 +1,71 @@ +#!/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/cpan/Test-Simple/t/Legacy/cmp_ok.t b/cpan/Test-Simple/t/Legacy/cmp_ok.t new file mode 100644 index 0000000000..07ed1a9f0b --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/cmp_ok.t @@ -0,0 +1,86 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; + +use lib 't/lib'; + +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, $error) = @_; + + my %expect; + if( $error ) { + $expect{ok} = 0; + $expect{error} = $error; + } + else { + $expect{ok} = eval "\$left $cmp \$right"; + $expect{error} = $@; + $expect{error} =~ s/ at .*\n?//; + } + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my $ok; + eval { $ok = cmp_ok($left, $cmp, $right, "cmp_ok"); }; + + $TB->is_num(!!$ok, !!$expect{ok}, " right return"); + + my $diag = $err->read; + + if ($@) { + $diag = $@; + $diag =~ s/ at .*\n?//; + } + + 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], + + [1, "=", 0, "= is not a valid comparison operator in cmp_ok()"], + [1, "+=", 0, "+= is not a valid comparison operator in cmp_ok()"], +); + +plan tests => scalar @Tests; +$TB->plan(tests => @Tests * 2); + +for my $test (@Tests) { + try_cmp_ok(@$test); +} diff --git a/cpan/Test-Simple/t/Legacy/dependents.t b/cpan/Test-Simple/t/Legacy/dependents.t new file mode 100644 index 0000000000..90e8938ebe --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/dependents.t @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +# Test important dependant modules so we don't accidentally half of CPAN. + +use strict; +use warnings; + +use Test::More; + +BEGIN { + plan skip_all => "Dependents only tested when releasing" unless $ENV{PERL_RELEASING}; +} + +require File::Spec; +use CPAN; + +CPAN::HandleConfig->load; +$CPAN::Config->{test_report} = 0; + +# Module which depend on Test::More to test +my @Modules = qw( + Test::Most + Test::Warn + Test::Exception + Test::Class + Test::Deep + Test::Differences + Test::NoWarnings +); + +# Modules which are known to be broken +my %Broken = map { $_ => 1 } qw( +); + +TODO: for my $name (@ARGV ? @ARGV : @Modules) { + local $TODO = "$name known to be broken" if $Broken{$name}; + + local $ENV{PERL5LIB} = "$ENV{PERL5LIB}:" . File::Spec->rel2abs("blib/lib"); + my $module = CPAN::Shell->expand("Module", $name); + $module->test; + ok( !$module->distribution->{make_test}->failed, $name ); +} + +done_testing(); diff --git a/cpan/Test-Simple/t/Legacy/diag.t b/cpan/Test-Simple/t/Legacy/diag.t new file mode 100644 index 0000000000..f5cb437d54 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/diag.t @@ -0,0 +1,81 @@ +#!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::Builder::NoOutput; +use Test::More tests => 7; + +my $test = Test::Builder::NoOutput->create; + +# Test diag() goes to todo_output() in a todo test. +{ + $test->todo_start(); + + $test->diag("a single line"); + is( $test->read('todo'), <<'DIAG', 'diag() with todo_output set' ); +# a single line +DIAG + + my $ret = $test->diag("multiple\n", "lines"); + is( $test->read('todo'), <<'DIAG', ' multi line' ); +# multiple +# lines +DIAG + ok( !$ret, 'diag returns false' ); + + $test->todo_end(); +} + + +# Test diagnostic formatting +{ + $test->diag("# foo"); + is( $test->read('err'), "# # foo\n", "diag() adds # even if there's one already" ); + + $test->diag("foo\n\nbar"); + is( $test->read('err'), <<'DIAG', " blank lines get escaped" ); +# foo +# +# bar +DIAG + + $test->diag("foo\n\nbar\n\n"); + is( $test->read('err'), <<'DIAG', " even at the end" ); +# foo +# +# bar +# +DIAG +} + + +# [rt.cpan.org 8392] diag(@list) emulates print +{ + $test->diag(qw(one two)); + + is( $test->read('err'), <<'DIAG' ); +# onetwo +DIAG +} diff --git a/cpan/Test-Simple/t/Legacy/died.t b/cpan/Test-Simple/t/Legacy/died.t new file mode 100644 index 0000000000..b4ee2fbbff --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/died.t @@ -0,0 +1,45 @@ +#!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/cpan/Test-Simple/t/Legacy/dont_overwrite_die_handler.t b/cpan/Test-Simple/t/Legacy/dont_overwrite_die_handler.t new file mode 100644 index 0000000000..51f4d08d4e --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/dont_overwrite_die_handler.t @@ -0,0 +1,21 @@ +#!/usr/bin/perl -w +use Config; # To prevent conflict with some strawberry-portable versions + +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; + +$handler_called = 0; +ok !eval { die }; +is $handler_called, 1, 'existing DIE handler not overridden'; diff --git a/cpan/Test-Simple/t/Legacy/eq_set.t b/cpan/Test-Simple/t/Legacy/eq_set.t new file mode 100644 index 0000000000..202f3d3665 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/eq_set.t @@ -0,0 +1,34 @@ +#!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/cpan/Test-Simple/t/Legacy/exit.t b/cpan/Test-Simple/t/Legacy/exit.t new file mode 100644 index 0000000000..8c9e16d162 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/exit.t @@ -0,0 +1,113 @@ +#!/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'; + } +} + +require Test::Builder; +my $TB = Test::Builder->create(); +$TB->level(0); + + +package main; + +use Cwd; +use File::Spec; + +my $Orig_Dir = cwd; + +my $Perl = File::Spec->rel2abs($^X); +if( $^O eq 'VMS' ) { + # Quiet noisy 'SYS$ABORT' + $Perl .= q{ -"I../lib"} if $ENV{PERL_CORE}; + $Perl .= q{ -"Mvmsish=hushed"}; +} + + +eval { require POSIX; &POSIX::WEXITSTATUS(0) }; +if( $@ ) { + *exitstatus = sub { $_[0] >> 8 }; +} +else { + *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) } +} + + +# Some OS' will alter the exit code to their own native sense... +# sometimes. Rather than deal with the exception we'll just +# build up the mapping. +print "# Building up a map of exit codes. May take a while.\n"; +my %Exit_Map; + +open my $fh, ">", "exit_map_test" or die $!; +print $fh <<'DONE'; +if ($^O eq 'VMS') { + require vmsish; + import vmsish qw(hushed); +} +my $exit = shift; +print "exit $exit\n"; +END { $? = $exit }; +DONE + +close $fh; +END { 1 while unlink "exit_map_test" } + +for my $exit (0..255) { + # This correctly emulates Test::Builder's behavior. + my $out = qx[$Perl exit_map_test $exit]; + $TB->like( $out, qr/^exit $exit\n/, "exit map test for $exit" ); + $Exit_Map{$exit} = exitstatus($?); +} +print "# Done.\n"; + + +my %Tests = ( + # File Exit Code + 'success.plx' => 0, + 'one_fail.plx' => 1, + 'two_fail.plx' => 2, + 'five_fail.plx' => 5, + 'extras.plx' => 2, + 'too_few.plx' => 255, + 'too_few_fail.plx' => 2, + 'death.plx' => 255, + 'last_minute_death.plx' => 255, + 'pre_plan_death.plx' => 'not zero', + 'death_in_eval.plx' => 0, + 'require.plx' => 0, + 'death_with_handler.plx' => 255, + 'exit.plx' => 1, + 'one_fail_without_plan.plx' => 1, + 'missing_done_testing.plx' => 254, + ); + +chdir 't'; +my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests)); +while( my($test_name, $exit_code) = each %Tests ) { + 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, $Exit_Map{0}, + "$test_name exited with $actual_exit ". + "(expected non-zero)"); + } + else { + $TB->is_num( $actual_exit, $Exit_Map{$exit_code}, + "$test_name exited with $actual_exit ". + "(expected $Exit_Map{$exit_code})"); + } +} + +$TB->done_testing( scalar keys(%Tests) + 256 ); + +# So any END block file cleanup works. +chdir $Orig_Dir; diff --git a/cpan/Test-Simple/t/Legacy/explain.t b/cpan/Test-Simple/t/Legacy/explain.t new file mode 100644 index 0000000000..cf2f550e95 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/explain.t @@ -0,0 +1,27 @@ +#!/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/cpan/Test-Simple/t/Legacy/extra.t b/cpan/Test-Simple/t/Legacy/extra.t new file mode 100644 index 0000000000..28febc3600 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/extra.t @@ -0,0 +1,63 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +use Test::Builder; +use Test::Builder::NoOutput; +use Test::More; + +my $TB = Test::Builder->new; +my $test = Test::Builder::NoOutput->create; +$test->plan( tests => 3 ); + +local $ENV{HARNESS_ACTIVE} = 0; + +$test->ok(1, 'Foo'); +$TB->is_eq($test->read(), <<END); +1..3 +ok 1 - Foo +END + +#line 30 +$test->ok(0, 'Bar'); +$TB->is_eq($test->read(), <<END); +not ok 2 - Bar +# Failed test 'Bar' +# at $0 line 30. +END + +$test->ok(1, 'Yar'); +$test->ok(1, 'Car'); +$TB->is_eq($test->read(), <<END); +ok 3 - Yar +ok 4 - Car +END + +#line 45 +$test->ok(0, 'Sar'); +$TB->is_eq($test->read(), <<END); +not ok 5 - Sar +# Failed test 'Sar' +# at $0 line 45. +END + +SKIP: { + skip 'Broken with new stuff' => 1; + $test->_ending(); + $TB->is_eq($test->read(), <<' END'); +# Looks like you planned 3 tests but ran 5. +# Looks like you failed 2 tests of 5 run. + END +} + +$TB->done_testing(5); diff --git a/cpan/Test-Simple/t/Legacy/extra_one.t b/cpan/Test-Simple/t/Legacy/extra_one.t new file mode 100644 index 0000000000..d77404e15d --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/extra_one.t @@ -0,0 +1,52 @@ +#!/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/cpan/Test-Simple/t/Legacy/fail-like.t b/cpan/Test-Simple/t/Legacy/fail-like.t new file mode 100644 index 0000000000..19e748f567 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/fail-like.t @@ -0,0 +1,75 @@ +#!/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 + + # Accept both old and new-style stringification + my $modifiers = (qr/foobar/ =~ /\Q(?^/) ? '\\^' : '-xism'; + + my $err_re = <<ERR; +# Failed test 'is foo like that' +# at .* line 1\. +# 'foo' +# doesn't match '\\(\\?$modifiers:that\\)' +ERR + + $TB->like($err->read, qr/^$err_re$/, 'failing errors'); +} + +{ + # line 62 + 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 62. +# 'not a regex' doesn't look much like a regex to me. +OUT + +} + +# Test::More thinks it failed. Override that. +Test::Builder->new->no_ending(1); diff --git a/cpan/Test-Simple/t/Legacy/fail-more.t b/cpan/Test-Simple/t/Legacy/fail-more.t new file mode 100644 index 0000000000..aab2d83031 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/fail-more.t @@ -0,0 +1,526 @@ +#!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 => 80); + +sub like ($$;$) { + my $c = Test::Stream::Context::context(); + $TB->like(@_); +} + +sub is ($$;$) { + my $c = Test::Stream::Context::context(); + $TB->is_eq(@_); +} + +sub main::out_ok ($$) { + my $c = Test::Stream::Context::context(); + $TB->is_eq( $out->read, shift ); + $TB->is_eq( $err->read, shift ); +} + +sub main::out_like ($$) { + my $c = Test::Stream::Context::context(); + my($output, $failure) = @_; + + $TB->like( $out->read, qr/$output/ ); + $TB->like( $err->read, qr/$failure/ ); +} + + +package main; + +require Test::More; +our $TODO; +my $Total = 38; +Test::More->import(tests => $Total); +$out->read; # clear the plan from $out + +# 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; + + +#line 38 +ok( 0, 'failing' ); +out_ok( <<OUT, <<ERR ); +not ok - failing +OUT +# Failed test 'failing' +# at $0 line 38. +ERR + + +#line 40 +is( "foo", "bar", 'foo is bar?'); +out_ok( <<OUT, <<ERR ); +not ok - foo is bar? +OUT +# Failed test 'foo is bar?' +# at $0 line 40. +# got: 'foo' +# expected: 'bar' +ERR + +#line 89 +is( undef, '', 'undef is empty string?'); +out_ok( <<OUT, <<ERR ); +not ok - undef is empty string? +OUT +# Failed test 'undef is empty string?' +# at $0 line 89. +# got: undef +# expected: '' +ERR + +#line 99 +is( undef, 0, 'undef is 0?'); +out_ok( <<OUT, <<ERR ); +not ok - undef is 0? +OUT +# Failed test 'undef is 0?' +# at $0 line 99. +# got: undef +# expected: '0' +ERR + +#line 110 +is( '', 0, 'empty string is 0?' ); +out_ok( <<OUT, <<ERR ); +not ok - empty string is 0? +OUT +# Failed test 'empty string is 0?' +# at $0 line 110. +# got: '' +# expected: '0' +ERR + +#line 121 +isnt("foo", "foo", 'foo isnt foo?' ); +out_ok( <<OUT, <<ERR ); +not ok - foo isnt foo? +OUT +# Failed test 'foo isnt foo?' +# at $0 line 121. +# got: 'foo' +# expected: anything else +ERR + +#line 132 +isn't("foo", "foo",'foo isn\'t foo?' ); +out_ok( <<OUT, <<ERR ); +not ok - foo isn't foo? +OUT +# Failed test 'foo isn\'t foo?' +# at $0 line 132. +# got: 'foo' +# expected: anything else +ERR + +#line 143 +isnt(undef, undef, 'undef isnt undef?'); +out_ok( <<OUT, <<ERR ); +not ok - undef isnt undef? +OUT +# Failed test 'undef isnt undef?' +# at $0 line 143. +# got: undef +# expected: anything else +ERR + +#line 154 +like( "foo", '/that/', 'is foo like that' ); +out_ok( <<OUT, <<ERR ); +not ok - is foo like that +OUT +# Failed test 'is foo like that' +# at $0 line 154. +# 'foo' +# doesn't match '/that/' +ERR + +#line 165 +unlike( "foo", '/foo/', 'is foo unlike foo' ); +out_ok( <<OUT, <<ERR ); +not ok - is foo unlike foo +OUT +# Failed test 'is foo unlike foo' +# at $0 line 165. +# 'foo' +# matches '/foo/' +ERR + +# Nick Clark found this was a bug. Fixed in 0.40. +# line 177 +like( "bug", '/(%)/', 'regex with % in it' ); +out_ok( <<OUT, <<ERR ); +not ok - regex with % in it +OUT +# Failed test 'regex with % in it' +# at $0 line 177. +# 'bug' +# doesn't match '/(%)/' +ERR + +#line 188 +fail('fail()'); +out_ok( <<OUT, <<ERR ); +not ok - fail() +OUT +# Failed test 'fail()' +# at $0 line 188. +ERR + +#line 197 +can_ok('Mooble::Hooble::Yooble', qw(this that)); +out_ok( <<OUT, <<ERR ); +not ok - Mooble::Hooble::Yooble->can(...) +OUT +# Failed test 'Mooble::Hooble::Yooble->can(...)' +# at $0 line 197. +# Mooble::Hooble::Yooble->can('this') failed +# Mooble::Hooble::Yooble->can('that') failed +ERR + +#line 208 +can_ok('Mooble::Hooble::Yooble', ()); +out_ok( <<OUT, <<ERR ); +not ok - Mooble::Hooble::Yooble->can(...) +OUT +# Failed test 'Mooble::Hooble::Yooble->can(...)' +# at $0 line 208. +# can_ok() called with no methods +ERR + +#line 218 +can_ok(undef, undef); +out_ok( <<OUT, <<ERR ); +not ok - ->can(...) +OUT +# Failed test '->can(...)' +# at $0 line 218. +# can_ok() called with empty class or reference +ERR + +#line 228 +can_ok([], "foo"); +out_ok( <<OUT, <<ERR ); +not ok - ARRAY->can('foo') +OUT +# Failed test 'ARRAY->can('foo')' +# at $0 line 228. +# ARRAY->can('foo') failed with an exception: +# Can't call method "can" on unblessed reference. +ERR + +#line 238 +isa_ok(bless([], "Foo"), "Wibble"); +out_ok( <<OUT, <<ERR ); +not ok - An object of class 'Foo' isa 'Wibble' +OUT +# Failed test 'An object of class 'Foo' isa 'Wibble'' +# at $0 line 238. +# An object of class 'Foo' isn't a 'Wibble' +ERR + +#line 248 +isa_ok(42, "Wibble", "My Wibble"); +out_ok( <<OUT, <<ERR ); +not ok - 'My Wibble' isa 'Wibble' +OUT +# Failed test ''My Wibble' isa 'Wibble'' +# at $0 line 248. +# 'My Wibble' isn't a 'Wibble' +ERR + +#line 252 +isa_ok(42, "Wibble"); +out_ok( <<OUT, <<ERR ); +not ok - The class (or class-like) '42' isa 'Wibble' +OUT +# Failed test 'The class (or class-like) '42' isa 'Wibble'' +# at $0 line 252. +# The class (or class-like) '42' isn't a 'Wibble' +ERR + +#line 258 +isa_ok(undef, "Wibble", "Another Wibble"); +out_ok( <<OUT, <<ERR ); +not ok - 'Another Wibble' isa 'Wibble' +OUT +# Failed test ''Another Wibble' isa 'Wibble'' +# at $0 line 258. +# 'Another Wibble' isn't defined +ERR + +#line 268 +isa_ok([], "HASH"); +out_ok( <<OUT, <<ERR ); +not ok - A reference of type 'ARRAY' isa 'HASH' +OUT +# Failed test 'A reference of type 'ARRAY' isa 'HASH'' +# at $0 line 268. +# A reference of type 'ARRAY' isn't a 'HASH' +ERR + +#line 278 +new_ok(undef); +out_like( <<OUT, <<ERR ); +not ok - undef->new\\(\\) died +OUT +# Failed test 'undef->new\\(\\) died' +# at $Filename line 278. +# Error was: Can't call method "new" on an undefined value at .* +ERR + +#line 288 +new_ok( "Does::Not::Exist" ); +out_like( <<OUT, <<ERR ); +not ok - Does::Not::Exist->new\\(\\) died +OUT +# Failed test 'Does::Not::Exist->new\\(\\) died' +# at $Filename line 288. +# 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 303 +new_ok( "Foo" ); +out_ok( <<OUT, <<ERR ); +not ok - undef isa 'Foo' +OUT +# Failed test 'undef isa 'Foo'' +# at $0 line 303. +# undef isn't defined +ERR + +# line 313 +new_ok( "Bar" ); +out_ok( <<OUT, <<ERR ); +not ok - A reference of type 'HASH' isa 'Bar' +OUT +# Failed test 'A reference of type 'HASH' isa 'Bar'' +# at $0 line 313. +# A reference of type 'HASH' isn't a 'Bar' +ERR + +#line 323 +new_ok( "Baz" ); +out_ok( <<OUT, <<ERR ); +not ok - An object of class 'Wibble' isa 'Baz' +OUT +# Failed test 'An object of class 'Wibble' isa 'Baz'' +# at $0 line 323. +# An object of class 'Wibble' isn't a 'Baz' +ERR + +#line 333 +new_ok( "Baz", [], "no args" ); +out_ok( <<OUT, <<ERR ); +not ok - 'no args' isa 'Baz' +OUT +# Failed test ''no args' isa 'Baz'' +# at $0 line 333. +# 'no args' isn't a 'Baz' +ERR + +#line 343 +cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' ); +out_ok( <<OUT, <<ERR ); +not ok - cmp_ok eq +OUT +# Failed test 'cmp_ok eq' +# at $0 line 343. +# got: 'foo' +# expected: 'bar' +ERR + +#line 354 +cmp_ok( 42.1, '==', 23, , ' ==' ); +out_ok( <<OUT, <<ERR ); +not ok - == +OUT +# Failed test ' ==' +# at $0 line 354. +# got: 42.1 +# expected: 23 +ERR + +#line 365 +cmp_ok( 42, '!=', 42 , ' !=' ); +out_ok( <<OUT, <<ERR ); +not ok - != +OUT +# Failed test ' !=' +# at $0 line 365. +# got: 42 +# expected: anything else +ERR + +#line 376 +cmp_ok( 1, '&&', 0 , ' &&' ); +out_ok( <<OUT, <<ERR ); +not ok - && +OUT +# Failed test ' &&' +# at $0 line 376. +# '1' +# && +# '0' +ERR + +# line 388 +cmp_ok( 42, 'eq', "foo", ' eq with numbers' ); +out_ok( <<OUT, <<ERR ); +not ok - eq with numbers +OUT +# Failed test ' eq with numbers' +# at $0 line 388. +# got: '42' +# expected: 'foo' +ERR + +{ + my $warnings = ''; + local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; + +# line 415 + cmp_ok( 42, '==', "foo", ' == with strings' ); + out_ok( <<OUT, <<ERR ); +not ok - == with strings +OUT +# Failed test ' == with strings' +# at $0 line 415. +# got: 42 +# expected: foo +ERR + My::Test::like( + $warnings, + qr/^Argument "foo" isn't numeric in .* at \(eval in cmp_ok\) $Filename line 415\.\n$/ + ); + $warnings = ''; +} + + +{ + my $warnings = ''; + local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; + +#line 437 + cmp_ok( undef, "ne", "", "undef ne empty string" ); + + $TB->is_eq( $out->read, <<OUT ); +not ok - undef ne empty string +OUT + + TODO: { + local $::TODO = 'cmp_ok() gives the wrong "expected" for undef'; + + $TB->is_eq( $err->read, <<ERR ); +# Failed test 'undef ne empty string' +# at $0 line 437. +# got: undef +# expected: '' +ERR + } + + My::Test::like( + $warnings, + qr/^Use of uninitialized value.* in string ne at \(eval in cmp_ok\) $Filename line 437.\n\z/ + ); +} + + +# generate a $!, it changes its value by context. +-e "wibblehibble"; +my $Errno_Number = $!+0; +my $Errno_String = $!.''; +#line 425 +cmp_ok( $!, 'eq', '', ' eq with stringified errno' ); +out_ok( <<OUT, <<ERR ); +not ok - eq with stringified errno +OUT +# Failed test ' eq with stringified errno' +# at $0 line 425. +# got: '$Errno_String' +# expected: '' +ERR + +#line 436 +cmp_ok( $!, '==', -1, ' eq with numerified errno' ); +out_ok( <<OUT, <<ERR ); +not ok - eq with numerified errno +OUT +# Failed test ' eq with numerified errno' +# at $0 line 436. +# got: $Errno_Number +# expected: -1 +ERR + +#line 447 +use_ok('Hooble::mooble::yooble'); +my $more_err_re = <<ERR; +# Failed test 'use Hooble::mooble::yooble;' +# at $Filename line 447\\. +# Tried to use 'Hooble::mooble::yooble'. +# Error: Can't locate Hooble.* in \\\@INC .* +ERR +out_like( + qr/^\Qnot ok - use Hooble::mooble::yooble;\E\n\z/, + qr/^$more_err_re/ +); + +#line 460 +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 460\\. +# Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'. +# Error: Can't locate ALL.* in \\\@INC .* +ERR +out_like( + qr/^\Qnot ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;\E\n\z/, + qr/^$more_err_re/ +); + + +END { + out_like( <<OUT, <<ERR ); +OUT +# Looks like you failed $Total tests of $Total. +ERR + + exit(0); +} diff --git a/cpan/Test-Simple/t/Legacy/fail.t b/cpan/Test-Simple/t/Legacy/fail.t new file mode 100644 index 0000000000..ccf0c74893 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/fail.t @@ -0,0 +1,56 @@ +#!perl -w + +# Simple test of what failure output looks like + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +# Normalize the output whether we're running under Test::Harness or not. +local $ENV{HARNESS_ACTIVE} = 0; + +use Test::Builder; +use Test::Builder::NoOutput; + +my $Test = Test::Builder->new; + +# Set up a builder to record some failing tests. +{ + my $tb = Test::Builder::NoOutput->create; + $tb->plan( tests => 5 ); + +#line 28 + $tb->ok( 1, 'passing' ); + $tb->ok( 2, 'passing still' ); + $tb->ok( 3, 'still passing' ); + $tb->ok( 0, 'oh no!' ); + $tb->ok( 0, 'damnit' ); + $tb->_ending; + + $Test->is_eq($tb->read('out'), <<OUT); +1..5 +ok 1 - passing +ok 2 - passing still +ok 3 - still passing +not ok 4 - oh no! +not ok 5 - damnit +OUT + + $Test->is_eq($tb->read('err'), <<ERR); +# Failed test 'oh no!' +# at $0 line 31. +# Failed test 'damnit' +# at $0 line 32. +# Looks like you failed 2 tests of 5. +ERR + + $Test->done_testing(2); +} diff --git a/cpan/Test-Simple/t/Legacy/fail_one.t b/cpan/Test-Simple/t/Legacy/fail_one.t new file mode 100644 index 0000000000..61d7c081ff --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/fail_one.t @@ -0,0 +1,43 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +# Normalize the output whether we're running under Test::Harness or not. +local $ENV{HARNESS_ACTIVE} = 0; + +use Test::Builder; +use Test::Builder::NoOutput; + +my $Test = Test::Builder->new; + +{ + my $tb = Test::Builder::NoOutput->create; + + $tb->plan( tests => 1 ); + +#line 28 + $tb->ok(0); + $tb->_ending; + + $Test->is_eq($tb->read('out'), <<OUT); +1..1 +not ok 1 +OUT + + $Test->is_eq($tb->read('err'), <<ERR); +# Failed test at $0 line 28. +# Looks like you failed 1 test of 1. +ERR + + $Test->done_testing(2); +} diff --git a/cpan/Test-Simple/t/Legacy/filehandles.t b/cpan/Test-Simple/t/Legacy/filehandles.t new file mode 100644 index 0000000000..f7dad5d7ea --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/filehandles.t @@ -0,0 +1,18 @@ +#!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/cpan/Test-Simple/t/Legacy/fork.t b/cpan/Test-Simple/t/Legacy/fork.t new file mode 100644 index 0000000000..fd895b450f --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/fork.t @@ -0,0 +1,34 @@ +#!/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; +} + +my $pid = fork; +if( $pid ) { # parent + pass("Only the parent should process the ending, not the child"); + waitpid($pid, 0); +} +else { + exit; # child +} + diff --git a/cpan/Test-Simple/t/Legacy/fork_in_subtest.t b/cpan/Test-Simple/t/Legacy/fork_in_subtest.t new file mode 100644 index 0000000000..3ed851a638 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/fork_in_subtest.t @@ -0,0 +1,40 @@ +use strict; +use warnings; + +use Config; + +BEGIN { + my $Can_Fork = $Config{d_fork} || + (($^O eq 'MSWin32' || $^O eq 'NetWare') and + $Config{useithreads} and + $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ + ); + + unless( $Can_Fork ) { + require Test::More; + Test::More::plan(skip_all => "This system cannot fork"); + exit 0; + } +} + +use Test::Stream; +use Test::More; +# This just goes to show how silly forking inside a subtest would actually +# be.... + +ok(1, "fine $$"); + +my $pid; +subtest my_subtest => sub { + ok(1, "inside 1 | $$"); + $pid = fork(); + ok(1, "inside 2 | $$"); +}; + +if($pid) { + waitpid($pid, 0); + + ok(1, "after $$"); + + done_testing; +} diff --git a/cpan/Test-Simple/t/Legacy/harness_active.t b/cpan/Test-Simple/t/Legacy/harness_active.t new file mode 100644 index 0000000000..bda5dae318 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/harness_active.t @@ -0,0 +1,88 @@ +#!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/cpan/Test-Simple/t/Legacy/import.t b/cpan/Test-Simple/t/Legacy/import.t new file mode 100644 index 0000000000..68a36138bc --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/import.t @@ -0,0 +1,12 @@ +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/cpan/Test-Simple/t/Legacy/is_deeply_dne_bug.t b/cpan/Test-Simple/t/Legacy/is_deeply_dne_bug.t new file mode 100644 index 0000000000..f4578a6460 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/is_deeply_dne_bug.t @@ -0,0 +1,47 @@ +#!/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/cpan/Test-Simple/t/Legacy/is_deeply_fail.t b/cpan/Test-Simple/t/Legacy/is_deeply_fail.t new file mode 100644 index 0000000000..b955d290f4 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/is_deeply_fail.t @@ -0,0 +1,421 @@ +#!/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 => 100); + +# Utility testing functions. +sub ok ($;$) { + return $TB->ok(@_); +} + +sub is ($$;$) { + my($thing, $that, $name) = @_; + + my $ok = $TB->is_eq($$thing, $that, $name); + + $$thing = ''; + + return $ok; +} + +sub like ($$;$) { + my($thing, $regex, $name) = @_; + $regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s; + + my $ok = $TB->like($$thing, $regex, $name); + + $$thing = ''; + + 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 + +} + + +# rt.cpan.org 53469 +{ + + # Accept both old and new-style stringification + my $modifiers = (qr/foobar/ =~ /\Q(?^/) ? '^' : '-xism'; +#line 380 + ok !is_deeply( qr/a/, qr/b/, "different regexes" ); + is( $out, "not ok 29 - different regexes\n" ); + is( $err, <<ERR, ' right diagnostic' ); +# Failed test 'different regexes' +# at $0 line 380. +# Structures begin differing at: +# \$got = (?$modifiers:a) +# \$expected = (?$modifiers:b) +ERR +} + + +# false values that should not compare equal +{ + ok !is_deeply( 0, '', "0 != ''" ); + is( $out, "not ok 30 - 0 != ''\n" ); + ok !is_deeply( 0, undef, "0 != undef" ); + is( $out, "not ok 31 - 0 != undef\n" ); + ok !is_deeply( '', undef, "'' != undef" ); + is( $out, "not ok 32 - '' != undef\n" ); + + ok !is_deeply( [0], [''], "[0] != ['']" ); + is( $out, "not ok 33 - [0] != ['']\n" ); + ok !is_deeply( [0], [undef], "[0] != [undef]" ); + is( $out, "not ok 34 - [0] != [undef]\n" ); + ok !is_deeply( [''], [undef], "[''] != [undef]" ); + is( $out, "not ok 35 - [''] != [undef]\n" ); + + ok !is_deeply( [0], [], "[0] != []" ); + is( $out, "not ok 36 - [0] != []\n" ); + ok !is_deeply( [undef], [], "[undef] != []" ); + is( $out, "not ok 37 - [undef] != []\n" ); + ok !is_deeply( [''], [], "[''] != []" ); + is( $out, "not ok 38 - [''] != []\n" ); + + ok !is_deeply( {x => 0}, {x => ''}, "{x => 0} != {x => ''}" ); + is( $out, "not ok 39 - {x => 0} != {x => ''}\n" ); + ok !is_deeply( {x => 0}, {x => undef}, "{x => 0} != {x => undef}" ); + is( $out, "not ok 40 - {x => 0} != {x => undef}\n" ); + ok !is_deeply( {x => ''}, {x => undef}, "{x => ''} != {x => undef}" ); + is( $out, "not ok 41 - {x => ''} != {x => undef}\n" ); +} diff --git a/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t b/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t new file mode 100644 index 0000000000..66a6641fa7 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/is_deeply_with_threads.t @@ -0,0 +1,74 @@ +#!/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 { + if ($] == 5.010000) { + print "1..0 # Threads are broken on 5.10.0\n"; + exit 0; + } + + my $works = 1; + $works &&= $] >= 5.008001; + $works &&= $Config{'useithreads'}; + $works &&= eval { require threads; 'threads'->import; 1 }; + + unless ($works) { + 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/cpan/Test-Simple/t/Legacy/missing.t b/cpan/Test-Simple/t/Legacy/missing.t new file mode 100644 index 0000000000..3996b6de4b --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/missing.t @@ -0,0 +1,56 @@ +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/cpan/Test-Simple/t/Legacy/new_ok.t b/cpan/Test-Simple/t/Legacy/new_ok.t new file mode 100644 index 0000000000..2579e67218 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/new_ok.t @@ -0,0 +1,44 @@ +#!/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(); +}; +my $error = $@; +$error =~ s/\.?\n.*$//gsm; +is $error, sprintf "new_ok() must be given at least a class at %s line %d", $0, __LINE__ - 4; diff --git a/cpan/Test-Simple/t/Legacy/no_plan.t b/cpan/Test-Simple/t/Legacy/no_plan.t new file mode 100644 index 0000000000..5f392e40e1 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/no_plan.t @@ -0,0 +1,33 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::More tests => 7; + +my $tb = Test::Builder->create; + +#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"); + +{ + my $warning = ''; + local $SIG{__WARN__} = sub { $warning .= join '', @_ }; + +#line 31 + ok $tb->plan(no_plan => 1); + is( $warning, "no_plan takes no arguments at $0 line 31.\n" ); + is $tb->has_plan, 'no_plan'; +} diff --git a/cpan/Test-Simple/t/Legacy/no_tests.t b/cpan/Test-Simple/t/Legacy/no_tests.t new file mode 100644 index 0000000000..eafa38cacc --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/no_tests.t @@ -0,0 +1,44 @@ +#!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/cpan/Test-Simple/t/Legacy/note.t b/cpan/Test-Simple/t/Legacy/note.t new file mode 100644 index 0000000000..fb98fb4029 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/note.t @@ -0,0 +1,30 @@ +#!/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::Builder::NoOutput; + +use Test::More tests => 2; + +{ + my $tb = Test::Builder::NoOutput->create; + + $tb->note("foo"); + + $tb->reset_outputs; + + is $tb->read('out'), "# foo\n"; + is $tb->read('err'), ''; +} + diff --git a/cpan/Test-Simple/t/Legacy/overload.t b/cpan/Test-Simple/t/Legacy/overload.t new file mode 100644 index 0000000000..fe9bc46e5a --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/overload.t @@ -0,0 +1,86 @@ +#!/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 => 19; + + +package Overloaded; + +use overload + q{eq} => sub { $_[0]->{string} eq $_[1] }, + q{==} => sub { $_[0]->{num} == $_[1] }, + q{""} => sub { $_[0]->{stringify}++; $_[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'; + +cmp_ok $obj, 'eq', 'foo', 'cmp_ok() eq'; +is $obj->{stringify}, 0, ' does not stringify'; +is $obj, 'foo', 'is() with string overloading'; +cmp_ok $obj, '==', 42, 'cmp_ok() with number overloading'; +is $obj->{numify}, 0, ' 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'); +} + + +# Make sure 0 isn't a special case. [rt.cpan.org 41109] +{ + my $obj = Overloaded->new('0', 42); + isa_ok $obj, 'Overloaded'; + + cmp_ok $obj, 'eq', '0', 'cmp_ok() eq'; + is $obj->{stringify}, 0, ' does not stringify'; + is $obj, '0', 'is() with string overloading'; +} diff --git a/cpan/Test-Simple/t/Legacy/overload_threads.t b/cpan/Test-Simple/t/Legacy/overload_threads.t new file mode 100644 index 0000000000..379e347bae --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/overload_threads.t @@ -0,0 +1,60 @@ +#!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/cpan/Test-Simple/t/Legacy/plan.t b/cpan/Test-Simple/t/Legacy/plan.t new file mode 100644 index 0000000000..2b6b2fdc78 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/plan.t @@ -0,0 +1,21 @@ +#!/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("Tried to plan twice!\n %s line %d\n %s line %d\n", $0, __LINE__ - 2, $0, __LINE__ - 1), + 'disallow double plan' ); +eval { plan 'no_plan' }; +is( $@, sprintf("Tried to plan twice!\n %s line %d\n %s line %d\n", $0, __LINE__ - 5, $0, __LINE__ - 1), + 'disallow changing plan' ); + +pass('Just testing plan()'); +pass('Testing it some more'); diff --git a/cpan/Test-Simple/t/Legacy/plan_bad.t b/cpan/Test-Simple/t/Legacy/plan_bad.t new file mode 100644 index 0000000000..179356dbc1 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/plan_bad.t @@ -0,0 +1,37 @@ +#!/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/cpan/Test-Simple/t/Legacy/plan_is_noplan.t b/cpan/Test-Simple/t/Legacy/plan_is_noplan.t new file mode 100644 index 0000000000..1e696042ef --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/plan_is_noplan.t @@ -0,0 +1,32 @@ +#!/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 => 1; + +use Test::Builder::NoOutput; + +{ + my $tb = Test::Builder::NoOutput->create; + + $tb->plan('no_plan'); + + $tb->ok(1, 'foo'); + $tb->_ending; + + is($tb->read, <<OUT); +ok 1 - foo +1..1 +OUT +} + diff --git a/cpan/Test-Simple/t/Legacy/plan_no_plan.t b/cpan/Test-Simple/t/Legacy/plan_no_plan.t new file mode 100644 index 0000000000..59fab4d21c --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/plan_no_plan.t @@ -0,0 +1,44 @@ +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::More; + +BEGIN { + require warnings; + if( eval "warnings->can('carp')" ) { + plan skip_all => 'Modern::Open is installed, which breaks this test'; + } + 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/cpan/Test-Simple/t/Legacy/plan_shouldnt_import.t b/cpan/Test-Simple/t/Legacy/plan_shouldnt_import.t new file mode 100644 index 0000000000..b6eb064244 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/plan_shouldnt_import.t @@ -0,0 +1,16 @@ +#!/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/cpan/Test-Simple/t/Legacy/plan_skip_all.t b/cpan/Test-Simple/t/Legacy/plan_skip_all.t new file mode 100644 index 0000000000..528df5f50d --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/plan_skip_all.t @@ -0,0 +1,12 @@ +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/cpan/Test-Simple/t/Legacy/pod.t b/cpan/Test-Simple/t/Legacy/pod.t new file mode 100644 index 0000000000..ac55c162df --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/pod.t @@ -0,0 +1,7 @@ +#!/usr/bin/perl -w + +use Test::More; +plan skip_all => "POD tests skipped unless AUTHOR_TESTING is set" unless $ENV{AUTHOR_TESTING}; +my $test_pod = eval "use Test::Pod 1.00; 1"; +plan skip_all => "Test::Pod 1.00 required for testing POD" unless $test_pod; +all_pod_files_ok(); diff --git a/cpan/Test-Simple/t/Legacy/require_ok.t b/cpan/Test-Simple/t/Legacy/require_ok.t new file mode 100644 index 0000000000..56d01bc108 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/require_ok.t @@ -0,0 +1,22 @@ +#!/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 => 4; + +# 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" ); diff --git a/cpan/Test-Simple/t/Legacy/ribasushi_diag.t b/cpan/Test-Simple/t/Legacy/ribasushi_diag.t new file mode 100644 index 0000000000..570ee5159b --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/ribasushi_diag.t @@ -0,0 +1,59 @@ +use strict; +use warnings; + +use Test::More; + +BEGIN { + my $has_module = eval { require SQL::Abstract::Test; 1 }; + my $required = $ENV{AUTHOR_TESTING}; + + if ($required && !$has_module) { + die "This test requires 'SQL::Abstract::Test' to be installed when AUTHOR_TESTING.\n"; + } + + unless($required) { + plan skip_all => "Only run when AUTHOR_TESTING is set"; + } +} + +{ + package Worker; + + sub do_work { + local $Test::Builder::Level = $Test::Builder::Level + 2; + shift->(); + } +} + +use SQL::Abstract::Test; +use Test::Stream::Tester; + +my $events = intercept { + local $TODO = "Not today"; + + Worker::do_work( + sub { + SQL::Abstract::Test::is_same_sql_bind( + 'buh', [], + 'bah', [1], + ); + } + ); +}; + +ok( !(grep { $_->context->in_todo ? 0 : 1 } @{$events->[0]->diag}), "All diag is todo" ); + +events_are( + $events, + check { + event ok => { + in_todo => 1, + }; + event note => { in_todo => 1 }; + event note => { in_todo => 1 }; + dir 'end'; + }, + "All events are TODO" +); + +done_testing; diff --git a/cpan/Test-Simple/t/Legacy/ribasushi_threads.t b/cpan/Test-Simple/t/Legacy/ribasushi_threads.t new file mode 100644 index 0000000000..32a7d1f0ae --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/ribasushi_threads.t @@ -0,0 +1,77 @@ +use Config; + +BEGIN { + if ($] == 5.010000) { + print "1..0 # Threads are broken on 5.10.0\n"; + exit 0; + } + + my $works = 1; + $works &&= $] >= 5.008001; + $works &&= $Config{'useithreads'}; + $works &&= eval { require threads; 'threads'->import; 1 }; + + unless ($works) { + 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; + } + + if ($INC{'Devel/Cover.pm'}) { + print "1..0 # SKIP Devel::Cover does not work with threads yet\n"; + exit 0; + } +} + +use threads; + +use strict; +use warnings; + +use Test::More; + +# basic tests +{ + pass('Test starts'); + my $ct_num = Test::More->builder->current_test; + + my $newthread = async { + my $out = ''; + + #simulate a subtest to not confuse the parent TAP emission + my $tb = Test::More->builder; + $tb->reset; + + Test::More->builder->current_test(0); + for (qw/output failure_output todo_output/) { + close $tb->$_; + open($tb->$_, '>', \$out); + } + + pass("In-thread ok") for (1, 2, 3); + + done_testing; + + close $tb->$_ for (qw/output failure_output todo_output/); + sleep(1); # tasty crashes without this + + $out; + }; + die "Thread creation failed: $! $@" if !defined $newthread; + + my $out = $newthread->join; + $out =~ s/^/ /gm; + + print $out; + + # workaround for older Test::More confusing the plan under threads + Test::More->builder->current_test($ct_num); + + pass("Made it to the end"); +} + +done_testing; diff --git a/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t b/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t new file mode 100644 index 0000000000..c60c61e650 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/ribasushi_threads2.t @@ -0,0 +1,51 @@ +use Config; + +BEGIN { + if ($] == 5.010000) { + print "1..0 # Threads are broken on 5.10.0\n"; + exit 0; + } + + my $works = 1; + $works &&= $] >= 5.008001; + $works &&= $Config{'useithreads'}; + $works &&= eval { require threads; 'threads'->import; 1 }; + + unless ($works) { + 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; + } + + if ($INC{'Devel/Cover.pm'}) { + print "1..0 # SKIP Devel::Cover does not work with threads yet\n"; + exit 0; + } +} + +use threads; + +use strict; +use warnings; + +use Test::More; + +{ + my $todo = sub { + my $out; + ok(1); + 42; + }; + + is( + threads->create($todo)->join, + 42, + "Correct result after do-er", + ); +} + +done_testing; diff --git a/cpan/Test-Simple/t/Legacy/simple.t b/cpan/Test-Simple/t/Legacy/simple.t new file mode 100644 index 0000000000..7297e9d6dd --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/simple.t @@ -0,0 +1,17 @@ +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/cpan/Test-Simple/t/Legacy/skip.t b/cpan/Test-Simple/t/Legacy/skip.t new file mode 100644 index 0000000000..df4d6e163a --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/skip.t @@ -0,0 +1,107 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::More; + +BEGIN { + require warnings; + if( eval "warnings->can('carp')" ) { + plan skip_all => 'Modern::Open is installed, which breaks this test'; + } +} + +# If we skip with the same name, Test::Harness will report it back and +# we won't get lots of false bug reports. +my $Why = "Just testing the skip interface."; + +SKIP: { + skip $Why, 2 + unless Pigs->can('fly'); + + my $pig = Pigs->new; + $pig->takeoff; + + ok( $pig->altitude > 0, 'Pig is airborne' ); + ok( $pig->airspeed > 0, ' and moving' ); +} + + +SKIP: { + skip "We're not skipping", 2 if 0; + + pass("Inside skip block"); + pass("Another inside"); +} + + +SKIP: { + skip "Again, not skipping", 2 if 0; + + my($pack, $file, $line) = caller; + is( $pack || '', '', 'calling package not interfered with' ); + is( $file || '', '', ' or file' ); + is( $line || '', '', ' or line' ); +} + + +SKIP: { + skip $Why, 2 if 1; + + die "A horrible death"; + fail("Deliberate failure"); + fail("And again"); +} + + +{ + my $warning; + local $SIG{__WARN__} = sub { $warning = join "", @_ }; + SKIP: { + # perl gets the line number a little wrong on the first + # statement inside a block. + 1 == 1; +#line 56 + skip $Why; + fail("So very failed"); + } + is( $warning, "skip() needs to know \$how_many tests are in the ". + "block at $0 line 56.\n", + 'skip without $how_many warning' ); +} + + +SKIP: { + skip "Not skipping here.", 4 if 0; + + pass("This is supposed to run"); + + # Testing out nested skips. + SKIP: { + skip $Why, 2; + fail("AHHH!"); + fail("You're a failure"); + } + + pass("This is supposed to run, too"); +} + +{ + my $warning = ''; + local $SIG{__WARN__} = sub { $warning .= join "", @_ }; + + SKIP: { + skip 1, "This is backwards" if 1; + + pass "This does not run"; + } + + like $warning, qr/^skip\(\) was passed a non-numeric number of tests/; +} + +done_testing; diff --git a/cpan/Test-Simple/t/Legacy/skipall.t b/cpan/Test-Simple/t/Legacy/skipall.t new file mode 100644 index 0000000000..08c8543be2 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/skipall.t @@ -0,0 +1,33 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +use Test::More; + +my $Test = Test::Builder->create; +$Test->plan(tests => 2); + +my $out = ''; +my $err = ''; +{ + my $tb = Test::More->builder; + $tb->output(\$out); + $tb->failure_output(\$err); + + plan 'skip_all'; +} + +END { + $Test->is_eq($out, "1..0 # SKIP\n"); + $Test->is_eq($err, ""); +} diff --git a/cpan/Test-Simple/t/Legacy/strays.t b/cpan/Test-Simple/t/Legacy/strays.t new file mode 100644 index 0000000000..02a99ab996 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/strays.t @@ -0,0 +1,27 @@ +#!/usr/bin/perl -w + +# Check that stray newlines in test output are properly handed. + +BEGIN { + print "1..0 # Skip not completed\n"; + exit 0; +} + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} +chdir 't'; + +use Test::Builder::NoOutput; +my $tb = Test::Builder::NoOutput->create; + +$tb->ok(1, "name\n"); +$tb->ok(0, "foo\nbar\nbaz"); +$tb->skip("\nmoofer"); +$tb->todo_skip("foo\n\n"); diff --git a/cpan/Test-Simple/t/Legacy/subtest/args.t b/cpan/Test-Simple/t/Legacy/subtest/args.t new file mode 100644 index 0000000000..d43ac5288e --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/args.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl -w + +use strict; +use Test::Builder; + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ( '../lib', 'lib' ); + } + else { + unshift @INC, 't/lib'; + } +} +use Test::Builder::NoOutput; + +my $tb = Test::Builder->new; + +$tb->ok( !eval { $tb->subtest() } ); +$tb->like( $@, qr/^\Qsubtest()'s second argument must be a code ref/ ); + +$tb->ok( !eval { $tb->subtest("foo") } ); +$tb->like( $@, qr/^\Qsubtest()'s second argument must be a code ref/ ); + +use Carp qw/confess/; +$tb->subtest('Arg passing', sub { + my $foo = shift; + my $child = Test::Builder->new; + $child->is_eq($foo, 'foo'); + $child->done_testing; + $child->finalize; +}, 'foo'); + +$tb->done_testing(); diff --git a/cpan/Test-Simple/t/Legacy/subtest/bail_out.t b/cpan/Test-Simple/t/Legacy/subtest/bail_out.t new file mode 100644 index 0000000000..d6b074c2cf --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/bail_out.t @@ -0,0 +1,64 @@ +#!/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; die }; +} + +use Test::Builder; +use Test::More; + +my $output; +my $TB = Test::More->builder; +$TB->output(\$output); + +my $Test = Test::Builder->create; +$Test->level(0); + +$Test->plan(tests => 2); + +plan tests => 4; + +ok 'foo'; +my $ok = eval { + subtest 'bar' => sub { + plan tests => 3; + ok 'sub_foo'; + subtest 'sub_bar' => sub { + plan tests => 3; + ok 'sub_sub_foo'; + ok 'sub_sub_bar'; + BAIL_OUT("ROCKS FALL! EVERYONE DIES!"); + ok 'sub_sub_baz'; + }; + ok 'sub_baz'; + }; + 1; +}; + +$Test->is_eq( $output, <<'OUT' ); +1..4 +ok 1 +# Subtest: bar + 1..3 + ok 1 + # Subtest: sub_bar + 1..3 + ok 1 + ok 2 + Bail out! ROCKS FALL! EVERYONE DIES! + Bail out! ROCKS FALL! EVERYONE DIES! +Bail out! ROCKS FALL! EVERYONE DIES! +OUT + +$Test->is_eq( $Exit_Code, 255 ); diff --git a/cpan/Test-Simple/t/Legacy/subtest/basic.t b/cpan/Test-Simple/t/Legacy/subtest/basic.t new file mode 100644 index 0000000000..964b60d6bf --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/basic.t @@ -0,0 +1,215 @@ +#!/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::Builder::NoOutput; + +use Test::More tests => 18; + +# Formatting may change if we're running under Test::Harness. +$ENV{HARNESS_ACTIVE} = 0; + +{ + my $tb = Test::Builder::NoOutput->create; + + $tb->plan( tests => 7 ); + for( 1 .. 3 ) { + $tb->ok( $_, "We're on $_" ); + $tb->diag("We ran $_"); + } + { + my $indented = $tb->child; + $indented->plan('no_plan'); + $indented->ok( 1, "We're on 1" ); + $indented->ok( 1, "We're on 2" ); + $indented->ok( 1, "We're on 3" ); + $indented->finalize; + } + for( 7, 8, 9 ) { + $tb->ok( $_, "We're on $_" ); + } + + is $tb->read, <<"END", 'Output should nest properly'; +1..7 +ok 1 - We're on 1 +# We ran 1 +ok 2 - We're on 2 +# We ran 2 +ok 3 - We're on 3 +# We ran 3 + ok 1 - We're on 1 + ok 2 - We're on 2 + ok 3 - We're on 3 + 1..3 +ok 4 - Child of $0 +ok 5 - We're on 7 +ok 6 - We're on 8 +ok 7 - We're on 9 +END +} +{ + my $tb = Test::Builder::NoOutput->create; + + $tb->plan('no_plan'); + for( 1 .. 1 ) { + $tb->ok( $_, "We're on $_" ); + $tb->diag("We ran $_"); + } + { + my $indented = $tb->child; + $indented->plan('no_plan'); + $indented->ok( 1, "We're on 1" ); + { + my $indented2 = $indented->child('with name'); + $indented2->plan( tests => 2 ); + $indented2->ok( 1, "We're on 2.1" ); + $indented2->ok( 1, "We're on 2.1" ); + $indented2->finalize; + } + $indented->ok( 1, 'after child' ); + $indented->finalize; + } + for(7) { + $tb->ok( $_, "We're on $_" ); + } + + $tb->_ending; + is $tb->read, <<"END", 'We should allow arbitrary nesting'; +ok 1 - We're on 1 +# We ran 1 + ok 1 - We're on 1 + 1..2 + ok 1 - We're on 2.1 + ok 2 - We're on 2.1 + ok 2 - with name + ok 3 - after child + 1..3 +ok 2 - Child of $0 +ok 3 - We're on 7 +1..3 +END +} + +{ +#line 108 + my $tb = Test::Builder::NoOutput->create; + + { + my $child = $tb->child('expected to fail'); + $child->plan( tests => 3 ); + $child->ok(1); + $child->ok(0); + $child->ok(3); + $child->finalize; + } + + { + my $child = $tb->child('expected to pass'); + $child->plan( tests => 3 ); + $child->ok(1); + $child->ok(2); + $child->ok(3); + $child->finalize; + } + is $tb->read, <<"END", 'Previous child failures should not force subsequent failures'; + 1..3 + ok 1 + not ok 2 + # Failed test at $0 line 114. + ok 3 + # Looks like you failed 1 test of 3. +not ok 1 - expected to fail +# Failed test 'expected to fail' +# at $0 line 116. + 1..3 + ok 1 + ok 2 + ok 3 +ok 2 - expected to pass +END +} +{ + my $tb = Test::Builder::NoOutput->create; + my $child = $tb->child('one'); + is $child->{$_}, $tb->{$_}, "The child should copy the ($_) filehandle" + foreach qw{Out_FH Todo_FH Fail_FH}; + $child->finalize; +} +{ + my $tb = Test::Builder::NoOutput->create; + my $child = $tb->child('one'); + can_ok $child, 'parent'; + is $child->parent, $tb, '... and it should return the parent of the child'; + ok !defined $tb->parent, '... but top level builders should not have parents'; + + can_ok $tb, 'name'; + is $tb->name, $0, 'The top level name should be $0'; + is $child->name, 'one', '... but child names should be whatever we set them to'; + $child->finalize; + $child = $tb->child; + is $child->name, 'Child of '.$tb->name, '... or at least have a sensible default'; + $child->finalize; +} +# Skip all subtests +{ + my $tb = Test::Builder::NoOutput->create; + + { + my $child = $tb->child('skippy says he loves you'); + eval { $child->plan( skip_all => 'cuz I said so' ) }; + ok my $error = $@, 'A child which does a "skip_all" should throw an exception'; + isa_ok $error, 'Test::Stream::Event', '... and the exception it throws'; + } + subtest 'skip all', sub { + plan skip_all => 'subtest with skip_all'; + ok 0, 'This should never be run'; + }; +} + +# to do tests +{ +#line 204 + my $tb = Test::Builder::NoOutput->create; + $tb->plan( tests => 1 ); + my $child = $tb->child; + $child->plan( tests => 1 ); + $child->todo_start( 'message' ); + $child->ok( 0 ); + $child->todo_end; + $child->finalize; + $tb->_ending; + is $tb->read, <<"END", 'TODO tests should not make the parent test fail'; +1..1 + 1..1 + not ok 1 # TODO message + # Failed (TODO) test at $0 line 209. +ok 1 - Child of $0 +END +} +{ + my $tb = Test::Builder::NoOutput->create; + $tb->plan( tests => 1 ); + my $child = $tb->child; + $child->finalize; + $tb->_ending; + my $expected = <<"END"; +1..1 +not ok 1 - Child of $0 +# Failed test 'Child of $0' +# at $0 line 225. +# No tests run for subtest. +END + like $tb->read, qr/\Q$expected/, + 'Not running subtests should make the parent test fail'; +} diff --git a/cpan/Test-Simple/t/Legacy/subtest/die.t b/cpan/Test-Simple/t/Legacy/subtest/die.t new file mode 100644 index 0000000000..7965e9088b --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/die.t @@ -0,0 +1,30 @@ +#!/usr/bin/perl -w + +# What happens when a subtest dies? + +use lib 't/lib'; + +use strict; +use Test::Builder; +use Test::Builder::NoOutput; + +my $Test = Test::Builder->new; + +{ + my $tb = Test::Builder::NoOutput->create; + + $tb->ok(1); + + $Test->ok( !eval { + $tb->subtest("death" => sub { + die "Death in the subtest"; + }); + 1; + }); + $Test->like( $@, qr/^Death in the subtest at $0 line /); + + $Test->ok( !$tb->parent, "the parent object is restored after a die" ); +} + + +$Test->done_testing(); diff --git a/cpan/Test-Simple/t/Legacy/subtest/do.t b/cpan/Test-Simple/t/Legacy/subtest/do.t new file mode 100644 index 0000000000..b034893f63 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/do.t @@ -0,0 +1,17 @@ +#!/usr/bin/perl -w + +# Test the idiom of running another test file as a subtest. + +use strict; +use Test::More; + +pass("First"); + +my $file = "t/Legacy/subtest/for_do_t.test"; +ok -e $file, "subtest test file exists"; + +subtest $file => sub { do $file }; + +pass("Last"); + +done_testing(4); diff --git a/cpan/Test-Simple/t/Legacy/subtest/exceptions.t b/cpan/Test-Simple/t/Legacy/subtest/exceptions.t new file mode 100644 index 0000000000..c4e57a982f --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/exceptions.t @@ -0,0 +1,67 @@ +#!/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::Builder::NoOutput; +use Test::More tests => 7; + +{ + my $tb = Test::Builder::NoOutput->create; + my $child = $tb->child('one'); + eval { $tb->child('two') }; + my $error = $@; + like $error, qr/\QYou already have a child named (one) running/, + 'Trying to create a child with another one active should fail'; + $child->finalize; +} +{ + my $tb = Test::Builder::NoOutput->create; + my $child = $tb->child('one'); + ok my $child2 = $child->child('two'), 'Trying to create nested children should succeed'; + eval { $child->finalize }; + my $error = $@; + like $error, qr/\QCan't call finalize() with child (two) active/, + '... but trying to finalize() a child with open children should fail'; + $child2->finalize; + $child->finalize; +} +{ + my $tb = Test::Builder::NoOutput->create; + my $child = $tb->child('one'); + eval { $child->DESTROY }; + like $@, qr/\QChild (one) exited without calling finalize()/, + 'Failing to call finalize should issue an appropriate diagnostic'; + ok !$tb->is_passing, '... and should cause the test suite to fail'; + $child->finalize; +} +{ + my $tb = Test::Builder::NoOutput->create; + + $tb->plan( tests => 7 ); + for( 1 .. 3 ) { + $tb->ok( $_, "We're on $_" ); + $tb->diag("We ran $_"); + } + { + my $indented = $tb->child; + $indented->plan('no_plan'); + $indented->ok( 1, "We're on 1" ); + eval { $tb->ok( 1, 'This should throw an exception' ) }; + $indented->finalize; + } + + my $error = $@; + like $error, qr/\QCannot run test (This should throw an exception) with active children/, + 'Running a test with active children should fail'; + ok !$tb->is_passing, '... and should cause the test suite to fail'; +} diff --git a/cpan/Test-Simple/t/Legacy/subtest/for_do_t.test b/cpan/Test-Simple/t/Legacy/subtest/for_do_t.test new file mode 100644 index 0000000000..413923bceb --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/for_do_t.test @@ -0,0 +1,9 @@ +# Test used by t/subtest/do.t + +use Test::More; + +pass("First"); +pass("Second"); +pass("Third"); + +done_testing(3); diff --git a/cpan/Test-Simple/t/Legacy/subtest/fork.t b/cpan/Test-Simple/t/Legacy/subtest/fork.t new file mode 100644 index 0000000000..0191e7894b --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/fork.t @@ -0,0 +1,51 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use Config; +use IO::Pipe; +use Test::Builder; +use Test::More; + +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; +} + +subtest 'fork within subtest' => sub { + plan tests => 2; + + my $pipe = IO::Pipe->new; + my $pid = fork; + defined $pid or plan skip_all => "Fork not working"; + + if ($pid) { + $pipe->reader; + my $child_output = do { local $/ ; <$pipe> }; + waitpid $pid, 0; + + is $?, 0, 'child exit status'; + like $child_output, qr/^[\s#]+Child Done\s*\z/, 'child output'; + } + else { + $pipe->writer; + + # Force all T::B output into the pipe, for the parent + # builder as well as the current subtest builder. + my $builder = Test::Builder->new; + $builder->output($pipe); + $builder->failure_output($pipe); + $builder->todo_output($pipe); + + diag 'Child Done'; + exit 0; + } +}; + diff --git a/cpan/Test-Simple/t/Legacy/subtest/implicit_done.t b/cpan/Test-Simple/t/Legacy/subtest/implicit_done.t new file mode 100644 index 0000000000..0963e72c59 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/implicit_done.t @@ -0,0 +1,31 @@ +#!/usr/bin/perl -w + +# A subtest without a plan implicitly calls "done_testing" + +use strict; +use Test::More; + +pass "Before"; + +subtest 'basic' => sub { + pass "Inside sub test"; +}; + +subtest 'with done' => sub { + pass 'This has done_testing'; + done_testing; +}; + +subtest 'with plan' => sub { + plan tests => 1; + pass 'I have a plan, Batman!'; +}; + +subtest 'skipping' => sub { + plan skip_all => 'Skipping'; + fail 'Shouldnt see me!'; +}; + +pass "After"; + +done_testing; diff --git a/cpan/Test-Simple/t/Legacy/subtest/line_numbers.t b/cpan/Test-Simple/t/Legacy/subtest/line_numbers.t new file mode 100644 index 0000000000..cc9c10db4f --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/line_numbers.t @@ -0,0 +1,131 @@ +#!/usr/bin/perl -w + +# Test Test::More::subtest(), focusing on correct line numbers in +# failed test diagnostics. + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ( '../lib', 'lib' ); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use warnings; + +use Test::More tests => 5; +use Test::Builder; +use Test::Builder::Tester; + +# Formatting may change if we're running under Test::Harness. +$ENV{HARNESS_ACTIVE} = 0; + +our %line; + +{ + test_out("# Subtest: namehere"); + test_out(" 1..3"); + test_out(" ok 1"); + test_out(" not ok 2"); + test_err(" # Failed test at $0 line $line{innerfail1}."); + test_out(" ok 3"); + test_err(" # Looks like you failed 1 test of 3."); + test_out("not ok 1 - namehere"); + test_err("# Failed test 'namehere'"); + test_err("# at $0 line $line{outerfail1}."); + + subtest namehere => sub { + plan tests => 3; + ok 1; + ok 0; BEGIN{ $line{innerfail1} = __LINE__ } + ok 1; + }; BEGIN{ $line{outerfail1} = __LINE__ } + + test_test("un-named inner tests"); +} +{ + test_out("# Subtest: namehere"); + test_out(" 1..3"); + test_out(" ok 1 - first is good"); + test_out(" not ok 2 - second is bad"); + test_err(" # Failed test 'second is bad'"); + test_err(" # at $0 line $line{innerfail2}."); + test_out(" ok 3 - third is good"); + test_err(" # Looks like you failed 1 test of 3."); + test_out("not ok 1 - namehere"); + test_err("# Failed test 'namehere'"); + test_err("# at $0 line $line{outerfail2}."); + + subtest namehere => sub { + plan tests => 3; + ok 1, "first is good"; + ok 0, "second is bad"; BEGIN{ $line{innerfail2} = __LINE__ } + ok 1, "third is good"; + }; BEGIN{ $line{outerfail2} = __LINE__ } + + test_test("named inner tests"); +} + +sub run_the_subtest { + subtest namehere => sub { + plan tests => 3; + ok 1, "first is good"; + ok 0, "second is bad"; BEGIN{ $line{innerfail3} = __LINE__ } + ok 1, "third is good"; + }; BEGIN{ $line{outerfail3} = __LINE__ } +} +{ + test_out("# Subtest: namehere"); + test_out(" 1..3"); + test_out(" ok 1 - first is good"); + test_out(" not ok 2 - second is bad"); + test_err(" # Failed test 'second is bad'"); + test_err(" # at $0 line $line{innerfail3}."); + test_out(" ok 3 - third is good"); + test_err(" # Looks like you failed 1 test of 3."); + test_out("not ok 1 - namehere"); + test_err("# Failed test 'namehere'"); + test_err("# at $0 line $line{outerfail3}."); + + run_the_subtest(); + + test_test("subtest() called from a sub"); +} +{ + test_out( "# Subtest: namehere"); + test_out( " 1..0"); + test_err( " # No tests run!"); + test_out( 'not ok 1 - namehere'); + test_err(q{# Failed test 'namehere'}); + test_err( "# at $0 line $line{outerfail4}."); + test_err( "# No tests run for subtest."); + + subtest namehere => sub { + done_testing; + }; BEGIN{ $line{outerfail4} = __LINE__ } + + test_test("lineno in 'No tests run' diagnostic"); +} +{ + test_out("# Subtest: namehere"); + test_out(" 1..1"); + test_out(" not ok 1 - foo is bar"); + test_err(" # Failed test 'foo is bar'"); + test_err(" # at $0 line $line{is_fail}."); + test_err(" # got: 'foo'"); + test_err(" # expected: 'bar'"); + test_err(" # Looks like you failed 1 test of 1."); + test_out('not ok 1 - namehere'); + test_err("# Failed test 'namehere'"); + test_err("# at $0 line $line{is_outer_fail}."); + + subtest namehere => sub { + plan tests => 1; + is 'foo', 'bar', 'foo is bar'; BEGIN{ $line{is_fail} = __LINE__ } + }; BEGIN{ $line{is_outer_fail} = __LINE__ } + + test_test("diag indent for is() in subtest"); +} diff --git a/cpan/Test-Simple/t/Legacy/subtest/plan.t b/cpan/Test-Simple/t/Legacy/subtest/plan.t new file mode 100644 index 0000000000..7e944ab283 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/plan.t @@ -0,0 +1,49 @@ +#!/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::Builder::NoOutput; + +use Test::More tests => 6; + +# Formatting may change if we're running under Test::Harness. +$ENV{HARNESS_ACTIVE} = 0; + +{ + ok defined &subtest, 'subtest() should be exported to our namespace'; + is prototype('subtest'), undef, '... has no prototype'; + + subtest 'subtest with plan', sub { + plan tests => 2; + ok 1, 'planned subtests should work'; + ok 1, '... and support more than one test'; + }; + subtest 'subtest without plan', sub { + plan 'no_plan'; + ok 1, 'no_plan subtests should work'; + ok 1, '... and support more than one test'; + ok 1, '... no matter how many tests are run'; + }; + subtest 'subtest with implicit done_testing()', sub { + ok 1, 'subtests with an implicit done testing should work'; + ok 1, '... and support more than one test'; + ok 1, '... no matter how many tests are run'; + }; + subtest 'subtest with explicit done_testing()', sub { + ok 1, 'subtests with an explicit done testing should work'; + ok 1, '... and support more than one test'; + ok 1, '... no matter how many tests are run'; + done_testing(); + }; +} diff --git a/cpan/Test-Simple/t/Legacy/subtest/predicate.t b/cpan/Test-Simple/t/Legacy/subtest/predicate.t new file mode 100644 index 0000000000..73b9c81056 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/predicate.t @@ -0,0 +1,166 @@ +#!/usr/bin/perl -w + +# Test the use of subtest() to define new test predicates that combine +# multiple existing predicates. + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ( '../lib', 'lib' ); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use warnings; + +use Test::More tests => 5; +use Test::Builder; +use Test::Builder::Tester; + +# Formatting may change if we're running under Test::Harness. +$ENV{HARNESS_ACTIVE} = 0; + +our %line; + +# Define a new test predicate with Test::More::subtest(), using +# Test::More predicates as building blocks... + +sub foobar_ok ($;$) { + my ($value, $name) = @_; + $name ||= "foobar_ok"; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + subtest $name => sub { + plan tests => 2; + ok $value =~ /foo/, "foo"; + ok $value =~ /bar/, "bar"; BEGIN{ $line{foobar_ok_bar} = __LINE__ } + }; +} +{ + test_out("# Subtest: namehere"); + test_out(" 1..2"); + test_out(" ok 1 - foo"); + test_out(" not ok 2 - bar"); + test_err(" # Failed test 'bar'"); + test_err(" # at $0 line $line{foobar_ok_bar}."); + test_err(" # Looks like you failed 1 test of 2."); + test_out("not ok 1 - namehere"); + test_err("# Failed test 'namehere'"); + test_err("# at $0 line ".(__LINE__+2)."."); + + foobar_ok "foot", "namehere"; + + test_test("foobar_ok failing line numbers"); +} + +# Wrap foobar_ok() to make another new predicate... + +sub foobar_ok_2 ($;$) { + my ($value, $name) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + foobar_ok($value, $name); +} +{ + test_out("# Subtest: namehere"); + test_out(" 1..2"); + test_out(" ok 1 - foo"); + test_out(" not ok 2 - bar"); + test_err(" # Failed test 'bar'"); + test_err(" # at $0 line $line{foobar_ok_bar}."); + test_err(" # Looks like you failed 1 test of 2."); + test_out("not ok 1 - namehere"); + test_err("# Failed test 'namehere'"); + test_err("# at $0 line ".(__LINE__+2)."."); + + foobar_ok_2 "foot", "namehere"; + + test_test("foobar_ok_2 failing line numbers"); +} + +# Define another new test predicate, this time using +# Test::Builder::subtest() rather than Test::More::subtest()... + +sub barfoo_ok ($;$) { + my ($value, $name) = @_; + $name ||= "barfoo_ok"; + + Test::Builder->new->subtest($name => sub { + plan tests => 2; + ok $value =~ /foo/, "foo"; + ok $value =~ /bar/, "bar"; BEGIN{ $line{barfoo_ok_bar} = __LINE__ } + }); +} +{ + test_out("# Subtest: namehere"); + test_out(" 1..2"); + test_out(" ok 1 - foo"); + test_out(" not ok 2 - bar"); + test_err(" # Failed test 'bar'"); + test_err(" # at $0 line $line{barfoo_ok_bar}."); + test_err(" # Looks like you failed 1 test of 2."); + test_out("not ok 1 - namehere"); + test_err("# Failed test 'namehere'"); + test_err("# at $0 line ".(__LINE__+2)."."); + + barfoo_ok "foot", "namehere"; + + test_test("barfoo_ok failing line numbers"); +} + +# Wrap barfoo_ok() to make another new predicate... + +sub barfoo_ok_2 ($;$) { + my ($value, $name) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + barfoo_ok($value, $name); +} +{ + test_out("# Subtest: namehere"); + test_out(" 1..2"); + test_out(" ok 1 - foo"); + test_out(" not ok 2 - bar"); + test_err(" # Failed test 'bar'"); + test_err(" # at $0 line $line{barfoo_ok_bar}."); + test_err(" # Looks like you failed 1 test of 2."); + test_out("not ok 1 - namehere"); + test_err("# Failed test 'namehere'"); + test_err("# at $0 line ".(__LINE__+2)."."); + + barfoo_ok_2 "foot", "namehere"; + + test_test("barfoo_ok_2 failing line numbers"); +} + +# A subtest-based predicate called from within a subtest +{ + test_out("# Subtest: outergroup"); + test_out(" 1..2"); + test_out(" ok 1 - this passes"); + test_out(" # Subtest: namehere"); + test_out(" 1..2"); + test_out(" ok 1 - foo"); + test_out(" not ok 2 - bar"); + test_err(" # Failed test 'bar'"); + test_err(" # at $0 line $line{barfoo_ok_bar}."); + test_err(" # Looks like you failed 1 test of 2."); + test_out(" not ok 2 - namehere"); + test_err(" # Failed test 'namehere'"); + test_err(" # at $0 line $line{ipredcall}."); + test_err(" # Looks like you failed 1 test of 2."); + test_out("not ok 1 - outergroup"); + test_err("# Failed test 'outergroup'"); + test_err("# at $0 line $line{outercall}."); + + subtest outergroup => sub { + plan tests => 2; + ok 1, "this passes"; + barfoo_ok_2 "foot", "namehere"; BEGIN{ $line{ipredcall} = __LINE__ } + }; BEGIN{ $line{outercall} = __LINE__ } + + test_test("outergroup with internal barfoo_ok_2 failing line numbers"); +} diff --git a/cpan/Test-Simple/t/Legacy/subtest/singleton.t b/cpan/Test-Simple/t/Legacy/subtest/singleton.t new file mode 100644 index 0000000000..0c25261f5b --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/singleton.t @@ -0,0 +1,38 @@ +#!/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 => 3; + +{ + + package Test::Singleton; + + use Test::Builder; + my $TB = Test::Builder->new; + + sub singleton_ok ($;$) { + my( $val, $name ) = @_; + $TB->ok( $val, $name ); + } +} + +ok 1, 'TB top level'; +subtest 'doing a subtest' => sub { + plan tests => 4; + ok 1, 'first test in subtest'; + Test::Singleton::singleton_ok(1, 'this should not fail'); + ok 1, 'second test in subtest'; + Test::Singleton::singleton_ok(1, 'this should not fail'); +}; +ok 1, 'left subtest'; diff --git a/cpan/Test-Simple/t/Legacy/subtest/threads.t b/cpan/Test-Simple/t/Legacy/subtest/threads.t new file mode 100644 index 0000000000..5d053ca2db --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/threads.t @@ -0,0 +1,25 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; + +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 Test::More; + +subtest 'simple test with threads on' => sub { + is( 1+1, 2, "simple test" ); + is( "a", "a", "another simple test" ); +}; + +pass("Parent retains sharedness"); + +done_testing(2); diff --git a/cpan/Test-Simple/t/Legacy/subtest/todo.t b/cpan/Test-Simple/t/Legacy/subtest/todo.t new file mode 100644 index 0000000000..82de40e3da --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/todo.t @@ -0,0 +1,204 @@ +#!/usr/bin/perl -w + +# Test todo subtests. +# +# A subtest in a todo context should have all of its diagnostic output +# redirected to the todo output destination, but individual tests +# within the subtest should not become todo tests themselves. + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ( '../lib', 'lib' ); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use warnings; + +use Test::More; +use Test::Builder; +use Test::Builder::Tester; + +# Formatting may change if we're running under Test::Harness. +$ENV{HARNESS_ACTIVE} = 0; + +our %line; + +# Repeat each test for various combinations of the todo reason, +# the mechanism by which it is set and $Level. +our @test_combos; +foreach my $level (1, 2, 3) { + push @test_combos, ['$TODO', 'Reason', $level], + ['todo_start', 'Reason', $level], + ['todo_start', '', $level], + ['todo_start', 0, $level]; +} + +plan tests => 8 * @test_combos; + +sub test_subtest_in_todo { + my ($name, $code, $want_out, $no_tests_run) = @_; + + #my $xxx = $no_tests_run ? 'No tests run for subtest "xxx"' : 'xxx'; + my @no_test_err = $no_tests_run ? ('# No tests run for subtest.') : (); + + chomp $want_out; + my @outlines = split /\n/, $want_out; + + foreach my $combo (@test_combos) { + my ($set_via, $todo_reason, $level) = @$combo; + + test_out( + "# Subtest: xxx", + @outlines, + map { my $x = $_; $x =~ s/\s+$//; $x } ( + "not ok 1 - xxx # TODO $todo_reason", + "# Failed (TODO) test 'xxx'", + "# at $0 line $line{xxx}.", + @no_test_err, + "not ok 2 - regular todo test # TODO $todo_reason", + "# Failed (TODO) test 'regular todo test'", + "# at $0 line $line{reg}.", + ) + ); + + { + local $TODO = $set_via eq '$TODO' ? $todo_reason : undef; + if ($set_via eq 'todo_start') { + Test::Builder->new->todo_start($todo_reason); + } + + subtest_at_level( + 'xxx', $code, $level); BEGIN{ $line{xxx} = __LINE__ } + ok 0, 'regular todo test'; BEGIN{ $line{reg} = __LINE__ } + + if ($set_via eq 'todo_start') { + Test::Builder->new->todo_end; + } + } + + last unless test_test("$name ($level), todo [$todo_reason] set via $set_via"); + } +} + +package Foo; # If several stack frames are in package 'main' then $Level + # could be wrong and $main::TODO might still be found. Using + # another package makes the tests more sensitive. + +sub main::subtest_at_level { + my ($name, $code, $level) = @_; + + if ($level > 1) { + local $Test::Builder::Level = $Test::Builder::Level + 1; + main::subtest_at_level($name, $code, $level-1); + } + else { + Test::Builder->new->subtest($name => $code); + } +} + +package main; + +test_subtest_in_todo("plan, no tests run", sub { + plan tests => 2; +}, <<END, 1); + 1..2 + # No tests run! +END + +test_subtest_in_todo("noplan, no tests run", sub { + plan 'no_plan'; +}, <<END, 1); + # No tests run! +END + +test_subtest_in_todo("missingplan, no tests run", sub { + 1; +}, <<END, 1); + 1..0 + # No tests run! +END + +test_subtest_in_todo("donetesting, no tests run", sub { + done_testing; +}, <<END, 1); + 1..0 + # No tests run! +END + +test_subtest_in_todo("1 failed test", sub { + ok 0, 'failme'; BEGIN { $line{fail1} = __LINE__ } +}, <<END); + not ok 1 - failme + # Failed test 'failme' + # at $0 line $line{fail1}. + 1..1 + # Looks like you failed 1 test of 1. +END + +test_subtest_in_todo("1fail, wrongplan", sub { + plan tests => 17; + ok 0, 'failme'; BEGIN { $line{fail2} = __LINE__ } +}, <<END); + 1..17 + not ok 1 - failme + # Failed test 'failme' + # at $0 line $line{fail2}. + # Looks like you planned 17 tests but ran 1. + # Looks like you failed 1 test of 1 run. +END + +test_subtest_in_todo("1fail, 1pass", sub { + ok 0, 'failme'; BEGIN { $line{fail3} = __LINE__ } + ok 1, 'passme'; +}, <<END); + not ok 1 - failme + # Failed test 'failme' + # at $0 line $line{fail3}. + ok 2 - passme + 1..2 + # Looks like you failed 1 test of 2. +END + +test_subtest_in_todo("todo tests in the subtest", sub { + ok 0, 'inner test 1'; BEGIN{ $line{in1} = __LINE__ } + + TODO: { + local $TODO = 'Inner1'; + ok 0, 'failing TODO a'; BEGIN{ $line{fta} = __LINE__ } + ok 1, 'unexpected pass a'; + } + + ok 0, 'inner test 2'; BEGIN{ $line{in2} = __LINE__ } + + Test::Builder->new->todo_start('Inner2'); + ok 0, 'failing TODO b'; BEGIN{ $line{ftb} = __LINE__ } + ok 1, 'unexpected pass b'; + Test::Builder->new->todo_end; + + ok 0, 'inner test 3'; BEGIN{ $line{in3} = __LINE__ } +}, <<END); + not ok 1 - inner test 1 + # Failed test 'inner test 1' + # at $0 line $line{in1}. + not ok 2 - failing TODO a # TODO Inner1 + # Failed (TODO) test 'failing TODO a' + # at $0 line $line{fta}. + ok 3 - unexpected pass a # TODO Inner1 + not ok 4 - inner test 2 + # Failed test 'inner test 2' + # at $0 line $line{in2}. + not ok 5 - failing TODO b # TODO Inner2 + # Failed (TODO) test 'failing TODO b' + # at $0 line $line{ftb}. + ok 6 - unexpected pass b # TODO Inner2 + not ok 7 - inner test 3 + # Failed test 'inner test 3' + # at $0 line $line{in3}. + 1..7 + # Looks like you failed 3 tests of 7. +END diff --git a/cpan/Test-Simple/t/Legacy/subtest/wstat.t b/cpan/Test-Simple/t/Legacy/subtest/wstat.t new file mode 100644 index 0000000000..ee2f19866d --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/subtest/wstat.t @@ -0,0 +1,24 @@ +#!/usr/bin/perl -w + +# Test that setting $? doesn't affect subtest success + +use strict; +use Test::More; + +subtest foo => sub { + plan tests => 1; + $? = 1; + pass('bar'); +}; + +is $?, 1, "exit code keeps on from a subtest"; + +subtest foo2 => sub { + plan tests => 1; + pass('bar2'); + $? = 1; +}; + +is $?, 1, "exit code keeps on from a subtest"; + +done_testing(4); diff --git a/cpan/Test-Simple/t/Legacy/tbm_doesnt_set_exported_to.t b/cpan/Test-Simple/t/Legacy/tbm_doesnt_set_exported_to.t new file mode 100644 index 0000000000..4202a69926 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/tbm_doesnt_set_exported_to.t @@ -0,0 +1,24 @@ +#!/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/cpan/Test-Simple/t/Legacy/test_use_ok.t b/cpan/Test-Simple/t/Legacy/test_use_ok.t new file mode 100644 index 0000000000..0b4b9a7d35 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/test_use_ok.t @@ -0,0 +1,40 @@ +use strict; +use Test::More; +use ok; +use ok 'strict'; +use ok 'Test::More'; +use ok 'ok'; + +my $class = 'Test::Builder'; +BEGIN { + ok(!$class, '$class is declared, but not yet set'); + + + my $success = eval 'use ok $class'; + my $error = $@; + + ok(!$success, "Threw an exception"); + like( + $error, + qr/^'use ok' called with an empty argument, did you try to use a package name from an uninitialized variable\?/, + "Threw expected exception" + ); + + + + $success = eval 'use ok $class, "xxx"'; + $error = $@; + + ok(!$success, "Threw an exception"); + like( + $error, + qr/^'use ok' called with an empty argument, did you try to use a package name from an uninitialized variable\?/, + "Threw expected exception when arguments are added" + ); +} + +my $class2; +BEGIN {$class2 = 'Test::Builder'}; +use ok $class2; + +done_testing; diff --git a/cpan/Test-Simple/t/Legacy/thread_taint.t b/cpan/Test-Simple/t/Legacy/thread_taint.t new file mode 100644 index 0000000000..ef7b89daef --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/thread_taint.t @@ -0,0 +1,5 @@ +#!/usr/bin/perl -w + +use Test::More tests => 1; + +ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' ); diff --git a/cpan/Test-Simple/t/Legacy/threads.t b/cpan/Test-Simple/t/Legacy/threads.t new file mode 100644 index 0000000000..51b374d9f9 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/threads.t @@ -0,0 +1,47 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Config; + +BEGIN { + if ($] == 5.010000) { + print "1..0 # Threads are broken on 5.10.0\n"; + exit 0; + } + + my $works = 1; + $works &&= $] >= 5.008001; + $works &&= $Config{'useithreads'}; + $works &&= eval { require threads; 'threads'->import; 1 }; + + unless ($works) { + 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 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/cpan/Test-Simple/t/Legacy/todo.t b/cpan/Test-Simple/t/Legacy/todo.t new file mode 100644 index 0000000000..9b5aa7583c --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/todo.t @@ -0,0 +1,165 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::More; + +BEGIN { + require warnings; + if( eval "warnings->can('carp')" ) { + plan skip_all => 'Modern::Open is installed, which breaks this test'; + } +} + +plan tests => 36; + + +$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: { + local $TODO = $Why; + + fail("Yet another failure"); +} + +pass("This is still not todo"); + + +TODO: { + local $TODO = "testing that error messages don't leak out of todo"; + + ok( 'this' eq 'that', 'ok' ); + + like( 'this', qr/that/, 'like' ); + is( 'this', 'that', 'is' ); + isnt( 'this', 'this', 'isnt' ); + + can_ok('Fooble', 'yarble'); + isa_ok('Fooble', 'yarble'); + use_ok('Fooble'); + require_ok('Fooble'); +} + + +TODO: { + todo_skip "Just testing todo_skip", 2; + + fail("Just testing 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()"; +} + +# line 200 +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/cpan/Test-Simple/t/Legacy/undef.t b/cpan/Test-Simple/t/Legacy/undef.t new file mode 100644 index 0000000000..d560f8231c --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/undef.t @@ -0,0 +1,107 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use Test::More; + +BEGIN { + require warnings; + if( eval "warnings->can('carp')" ) { + plan skip_all => 'Modern::Open is installed, which breaks this test'; + } +} + +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, qr/.*/, 'undef is like anything' ); +no_warnings; + +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 74 +cmp_ok( undef, '<=', 2, ' undef <= 2' ); +warnings_like(qr/Use of uninitialized value.* at \(eval in cmp_ok\) $Filename line 74\.\n/); + + + +my $tb = Test::More->builder; + +my $err = ''; +$tb->failure_output(\$err); +diag(undef); +$tb->reset_outputs; + +is( $err, "# undef\n" ); +no_warnings; + + +$tb->maybe_regex(undef); +no_warnings; + + +# test-more.googlecode.com #42 +{ + is_deeply([ undef ], [ undef ]); + no_warnings; +} + +done_testing; diff --git a/cpan/Test-Simple/t/Legacy/use_ok.t b/cpan/Test-Simple/t/Legacy/use_ok.t new file mode 100644 index 0000000000..9e858bc75e --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/use_ok.t @@ -0,0 +1,103 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; + +use lib 't/lib'; +use Test::More; + +note "Basic use_ok"; { + package Foo::one; + ::use_ok("Symbol"); + ::ok( defined &gensym, 'use_ok() no args exports defaults' ); +} + + +note "With one arg"; { + package Foo::two; + ::use_ok("Symbol", qw(qualify)); + ::ok( !defined &gensym, ' one arg, defaults overridden' ); + ::ok( defined &qualify, ' right function exported' ); +} + + +note "Multiple args"; { + package Foo::three; + ::use_ok("Symbol", qw(gensym ungensym)); + ::ok( defined &gensym && defined &ungensym, ' multiple args' ); +} + + +note "Defining constants"; { + 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'); +} + + +note "use Module VERSION"; { + package Foo::five; + ::use_ok("Symbol", 1.02); +} + + +note "use Module VERSION does not call import"; { + 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); +} + + +note "Signals are preserved"; { + package Foo::eight; + local $SIG{__DIE__}; + ::use_ok("SigDie"); + ::ok(defined $SIG{__DIE__}, ' SIG{__DIE__} preserved'); +} + + +note "Line numbers preserved"; { + my $package = "that_cares_about_line_numbers"; + + # Store the output of caller. + my @caller; + { + package that_cares_about_line_numbers; + + sub import { + @caller = caller; + return; + } + + $INC{"$package.pm"} = 1; # fool use into thinking it's already loaded + } + + ::use_ok($package); + my $line = __LINE__-1; + ::is( $caller[0], __PACKAGE__, "caller package preserved" ); + ::is( $caller[1], __FILE__, " file" ); + ::is( $caller[2], $line, " line" ); +} + + +note "not confused by functions vs class names"; { + $INC{"ok.pm"} = 1; + use_ok("ok"); # ok is a function inside Test::More + + $INC{"Foo/bar.pm"} = 1; + sub Foo::bar { 42 } + use_ok("Foo::bar"); # Confusing a class name with a function name +} + +done_testing; diff --git a/cpan/Test-Simple/t/Legacy/useing.t b/cpan/Test-Simple/t/Legacy/useing.t new file mode 100644 index 0000000000..c4ce507127 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/useing.t @@ -0,0 +1,19 @@ +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/cpan/Test-Simple/t/Legacy/utf8.t b/cpan/Test-Simple/t/Legacy/utf8.t new file mode 100644 index 0000000000..2930226e3e --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/utf8.t @@ -0,0 +1,67 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use strict; +use warnings; + +my $have_perlio; +BEGIN { + # All together so Test::More sees the open discipline + $have_perlio = eval q[ + require PerlIO; + binmode *STDOUT, ":encoding(utf8)"; + binmode *STDERR, ":encoding(utf8)"; + require 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"; + } +} + + +# Test utf8 is ok. +{ + my $uni = "\x{11e}"; + + my @warnings; + local $SIG{__WARN__} = sub { + push @warnings, @_; + }; + + is( $uni, $uni, "Testing $uni" ); + is_deeply( \@warnings, [] ); +} diff --git a/cpan/Test-Simple/t/Legacy/versions.t b/cpan/Test-Simple/t/Legacy/versions.t new file mode 100644 index 0000000000..49e146ad9c --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/versions.t @@ -0,0 +1,50 @@ +#!/usr/bin/perl -w + +# Make sure all the modules have the same version +# +# TBT has its own version system. + +use strict; +use Test::More; + +{ + local $SIG{__WARN__} = sub { 1 }; + require Test::Builder::Module; + require Test::Builder::Tester::Color; + require Test::Builder::Tester; + require Test::Builder; + require Test::More; + require Test::Simple; + require Test::Stream; + require Test::Stream::Tester; + require Test::Tester; + require Test::use::ok; + require ok; +} + +my $dist_version = Test::More->VERSION; + +like( $dist_version, qr/^ \d+ \. \d+ $/x, "Version number is sane" ); + +my @modules = qw( + Test::Builder::Module + Test::Builder::Tester::Color + Test::Builder::Tester + Test::Builder + Test::More + Test::Simple + Test::Stream + Test::Stream::Tester + Test::Tester + Test::use::ok + ok +); + +for my $module (@modules) { + my $file = $module; + $file =~ s{(::|')}{/}g; + $file .= ".pm"; + is( $module->VERSION, $module->VERSION, sprintf("%-22s %s", $module, $INC{$file}) ); +} + +done_testing(); |