diff options
| author | Nicholas Clark <nick@ccl4.org> | 2009-10-02 16:19:41 +0100 |
|---|---|---|
| committer | Nicholas Clark <nick@ccl4.org> | 2009-10-02 16:19:41 +0100 |
| commit | e0ee75a6976f08f9bc3868227f1cd11ab6507895 (patch) | |
| tree | 5366acf520d51f2f3961274ced349a4178685be5 /cpan/Test-Simple/t | |
| parent | 8c5b8ff02c62badaeb38078556879720bdf8945a (diff) | |
| download | perl-e0ee75a6976f08f9bc3868227f1cd11ab6507895.tar.gz | |
Move Test::Simple from ext/ to cpan/
Diffstat (limited to 'cpan/Test-Simple/t')
109 files changed, 5300 insertions, 0 deletions
diff --git a/cpan/Test-Simple/t/00test_harness_check.t b/cpan/Test-Simple/t/00test_harness_check.t new file mode 100644 index 0000000000..3ff4a13c63 --- /dev/null +++ b/cpan/Test-Simple/t/00test_harness_check.t @@ -0,0 +1,26 @@ +#!/usr/bin/perl -w + +# A test to make sure the new Test::Harness was installed properly. + +use Test::More; +plan tests => 1; + +my $TH_Version = 2.03; + +require Test::Harness; +unless( cmp_ok( eval $Test::Harness::VERSION, '>=', $TH_Version, "T::H version" ) ) { + diag <<INSTRUCTIONS; + +Test::Simple/More/Builder has features which depend on a version of +Test::Harness greater than $TH_Version. You have $Test::Harness::VERSION. +Please install a new version from CPAN. + +If you've already tried to upgrade Test::Harness and still get this +message, the new version may be "shadowed" by the old. Check the +output of Test::Harness's "make install" for "## Differing version" +messages. You can delete the old version by running +"make install UNINST=1". + +INSTRUCTIONS +} + diff --git a/cpan/Test-Simple/t/BEGIN_require_ok.t b/cpan/Test-Simple/t/BEGIN_require_ok.t new file mode 100644 index 0000000000..733d0bb861 --- /dev/null +++ b/cpan/Test-Simple/t/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/BEGIN_use_ok.t b/cpan/Test-Simple/t/BEGIN_use_ok.t new file mode 100644 index 0000000000..476badf7a2 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/Builder.t b/cpan/Test-Simple/t/Builder/Builder.t new file mode 100644 index 0000000000..a5bfd155a6 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/carp.t b/cpan/Test-Simple/t/Builder/carp.t new file mode 100644 index 0000000000..e89eeebfb9 --- /dev/null +++ b/cpan/Test-Simple/t/Builder/carp.t @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + + +use Test::More tests => 3; +use Test::Builder; + +my $tb = Test::Builder->create; +sub foo { $tb->croak("foo") } +sub bar { $tb->carp("bar") } + +eval { foo() }; +is $@, sprintf "foo at %s line %s.\n", $0, __LINE__ - 1; + +eval { $tb->croak("this") }; +is $@, sprintf "this at %s line %s.\n", $0, __LINE__ - 1; + +{ + my $warning = ''; + local $SIG{__WARN__} = sub { + $warning .= join '', @_; + }; + + bar(); + is $warning, sprintf "bar at %s line %s.\n", $0, __LINE__ - 1; +} diff --git a/cpan/Test-Simple/t/Builder/create.t b/cpan/Test-Simple/t/Builder/create.t new file mode 100644 index 0000000000..d584b30955 --- /dev/null +++ b/cpan/Test-Simple/t/Builder/create.t @@ -0,0 +1,40 @@ +#!/usr/bin/perl -w + +#!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/Builder/current_test.t b/cpan/Test-Simple/t/Builder/current_test.t new file mode 100644 index 0000000000..edd201c0e9 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/current_test_without_plan.t b/cpan/Test-Simple/t/Builder/current_test_without_plan.t new file mode 100644 index 0000000000..31f9589977 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/details.t b/cpan/Test-Simple/t/Builder/details.t new file mode 100644 index 0000000000..05d4828b4d --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/done_testing.t b/cpan/Test-Simple/t/Builder/done_testing.t new file mode 100644 index 0000000000..14a8f918b0 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/done_testing_double.t b/cpan/Test-Simple/t/Builder/done_testing_double.t new file mode 100644 index 0000000000..3a0bae247b --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/done_testing_plan_mismatch.t b/cpan/Test-Simple/t/Builder/done_testing_plan_mismatch.t new file mode 100644 index 0000000000..8208635359 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/done_testing_with_no_plan.t b/cpan/Test-Simple/t/Builder/done_testing_with_no_plan.t new file mode 100644 index 0000000000..ff5f40c197 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/done_testing_with_number.t b/cpan/Test-Simple/t/Builder/done_testing_with_number.t new file mode 100644 index 0000000000..c21458f54e --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/done_testing_with_plan.t b/cpan/Test-Simple/t/Builder/done_testing_with_plan.t new file mode 100644 index 0000000000..c0a3d0f014 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/fork_with_new_stdout.t b/cpan/Test-Simple/t/Builder/fork_with_new_stdout.t new file mode 100644 index 0000000000..e38c1d08cb --- /dev/null +++ b/cpan/Test-Simple/t/Builder/fork_with_new_stdout.t @@ -0,0 +1,54 @@ +#!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; + $b->ok((<$pipe> =~ /FROM CHILD: ok 1/), "ok 1 from child"); + $b->ok((<$pipe> =~ /FROM CHILD: 1\.\.1/), "1..1 from child"); + waitpid($pid, 0); +} +else { + $pipe->writer; + my $pipe_fd = $pipe->fileno; + close STDOUT; + open(STDOUT, ">&$pipe_fd"); + my $b = Test::Builder->new; + $b->reset; + $b->no_plan; + $b->ok(1); +} + + +=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/Builder/has_plan.t b/cpan/Test-Simple/t/Builder/has_plan.t new file mode 100644 index 0000000000..d0be86a97a --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/has_plan2.t b/cpan/Test-Simple/t/Builder/has_plan2.t new file mode 100644 index 0000000000..e13ea4af94 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/is_fh.t b/cpan/Test-Simple/t/Builder/is_fh.t new file mode 100644 index 0000000000..0eb3ec0b15 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/maybe_regex.t b/cpan/Test-Simple/t/Builder/maybe_regex.t new file mode 100644 index 0000000000..d1927a56e5 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/no_diag.t b/cpan/Test-Simple/t/Builder/no_diag.t new file mode 100644 index 0000000000..6fa538a82e --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/no_ending.t b/cpan/Test-Simple/t/Builder/no_ending.t new file mode 100644 index 0000000000..97e968e289 --- /dev/null +++ b/cpan/Test-Simple/t/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 +# supressed the ending diagnostics. +pass; +print "ok 2\n"; +print "ok 3\n"; diff --git a/cpan/Test-Simple/t/Builder/no_header.t b/cpan/Test-Simple/t/Builder/no_header.t new file mode 100644 index 0000000000..93e6bec34c --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/no_plan_at_all.t b/cpan/Test-Simple/t/Builder/no_plan_at_all.t new file mode 100644 index 0000000000..9029f6f6e7 --- /dev/null +++ b/cpan/Test-Simple/t/Builder/no_plan_at_all.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl -w + +# Test what happens when no plan is delcared 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/Builder/ok_obj.t b/cpan/Test-Simple/t/Builder/ok_obj.t new file mode 100644 index 0000000000..8678dbff8d --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/output.t b/cpan/Test-Simple/t/Builder/output.t new file mode 100644 index 0000000000..77e0e0bbb3 --- /dev/null +++ b/cpan/Test-Simple/t/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/Builder/reset.t b/cpan/Test-Simple/t/Builder/reset.t new file mode 100644 index 0000000000..6bff7fcf27 --- /dev/null +++ b/cpan/Test-Simple/t/Builder/reset.t @@ -0,0 +1,73 @@ +#!/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); + + +# Now reset it. +$tb->reset; + + +$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->no_ending, 0, 'no_ending' ); +$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' ); + +$tb->current_test(12); +$tb->level(0); +$tb->ok(1, 'final test to make sure output was reset'); + +$Test->current_test(13); +$Test->done_testing(13); diff --git a/cpan/Test-Simple/t/Builder/try.t b/cpan/Test-Simple/t/Builder/try.t new file mode 100644 index 0000000000..eeb3bcb1ab --- /dev/null +++ b/cpan/Test-Simple/t/Builder/try.t @@ -0,0 +1,42 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +use Test::More 'no_plan'; + +require Test::Builder; +my $tb = Test::Builder->new; + + +# Test that _try() has no effect on $@ and $! and is not effected by +# __DIE__ +{ + local $SIG{__DIE__} = sub { fail("DIE handler called: @_") }; + local $@ = 42; + local $! = 23; + + is $tb->_try(sub { 2 }), 2; + is $tb->_try(sub { return '' }), ''; + + is $tb->_try(sub { die; }), undef; + + is_deeply [$tb->_try(sub { die "Foo\n" })], [undef, "Foo\n"]; + + is $@, 42; + cmp_ok $!, '==', 23; +} + +ok !eval { + $tb->_try(sub { die "Died\n" }, die_on_fail => 1); +}; +is $@, "Died\n"; diff --git a/cpan/Test-Simple/t/More.t b/cpan/Test-Simple/t/More.t new file mode 100644 index 0000000000..21958cf2b6 --- /dev/null +++ b/cpan/Test-Simple/t/More.t @@ -0,0 +1,179 @@ +#!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 => 53; + +# 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] } + ); + +# These two tests must remain at the end. +is( $@, $Err, '$@ untouched' ); +cmp_ok( $!, '==', $Errno, '$! untouched' ); diff --git a/cpan/Test-Simple/t/Tester/tbt_01basic.t b/cpan/Test-Simple/t/Tester/tbt_01basic.t new file mode 100644 index 0000000000..769a1c4729 --- /dev/null +++ b/cpan/Test-Simple/t/Tester/tbt_01basic.t @@ -0,0 +1,55 @@ +#!/usr/bin/perl + +use Test::Builder::Tester tests => 9; +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("not ok 1 - should fail"); +test_err("# Failed test ($0 at line 28)"); +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_err("# Failed (TODO) test ($0 at line 52)"); +TODO: { + local $TODO = "Something"; + fail("name"); +} +test_test("testing failing with todo"); + diff --git a/cpan/Test-Simple/t/Tester/tbt_02fhrestore.t b/cpan/Test-Simple/t/Tester/tbt_02fhrestore.t new file mode 100644 index 0000000000..e37357171b --- /dev/null +++ b/cpan/Test-Simple/t/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/Tester/tbt_03die.t b/cpan/Test-Simple/t/Tester/tbt_03die.t new file mode 100644 index 0000000000..b9dba801eb --- /dev/null +++ b/cpan/Test-Simple/t/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/Tester/tbt_04line_num.t b/cpan/Test-Simple/t/Tester/tbt_04line_num.t new file mode 100644 index 0000000000..9e8365acbf --- /dev/null +++ b/cpan/Test-Simple/t/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/Tester/tbt_05faildiag.t b/cpan/Test-Simple/t/Tester/tbt_05faildiag.t new file mode 100644 index 0000000000..59ad721240 --- /dev/null +++ b/cpan/Test-Simple/t/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/Tester/tbt_06errormess.t b/cpan/Test-Simple/t/Tester/tbt_06errormess.t new file mode 100644 index 0000000000..d8d8a0fead --- /dev/null +++ b/cpan/Test-Simple/t/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(); + + # remeber 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/Tester/tbt_07args.t b/cpan/Test-Simple/t/Tester/tbt_07args.t new file mode 100644 index 0000000000..1b9393bdf4 --- /dev/null +++ b/cpan/Test-Simple/t/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(); + + # remeber 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/bad_plan.t b/cpan/Test-Simple/t/bad_plan.t new file mode 100644 index 0000000000..80e0e65bca --- /dev/null +++ b/cpan/Test-Simple/t/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/bail_out.t b/cpan/Test-Simple/t/bail_out.t new file mode 100644 index 0000000000..5cdc1f9969 --- /dev/null +++ b/cpan/Test-Simple/t/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/buffer.t b/cpan/Test-Simple/t/buffer.t new file mode 100644 index 0000000000..6039e4a6f7 --- /dev/null +++ b/cpan/Test-Simple/t/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/c_flag.t b/cpan/Test-Simple/t/c_flag.t new file mode 100644 index 0000000000..a33963415e --- /dev/null +++ b/cpan/Test-Simple/t/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/circular_data.t b/cpan/Test-Simple/t/circular_data.t new file mode 100644 index 0000000000..2fd819e1f4 --- /dev/null +++ b/cpan/Test-Simple/t/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/cmp_ok.t b/cpan/Test-Simple/t/cmp_ok.t new file mode 100644 index 0000000000..de1a7e634d --- /dev/null +++ b/cpan/Test-Simple/t/cmp_ok.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib', '../lib/Test/Simple/t/lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; + +require Test::Builder; +my $TB = Test::Builder->create; +$TB->level(0); + +sub try_cmp_ok { + my($left, $cmp, $right) = @_; + + my %expect; + $expect{ok} = eval "\$left $cmp \$right"; + $expect{error} = $@; + $expect{error} =~ s/ at .*\n?//; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + my $ok = cmp_ok($left, $cmp, $right, "cmp_ok"); + $TB->is_num(!!$ok, !!$expect{ok}, " right return"); + + my $diag = $err->read; + if( !$ok and $expect{error} ) { + $diag =~ s/^# //mg; + $TB->like( $diag, qr/\Q$expect{error}\E/, " expected error" ); + } + elsif( $ok ) { + $TB->is_eq( $diag, '', " passed without diagnostic" ); + } + else { + $TB->ok(1, " failed without diagnostic"); + } +} + + +use Test::More; +Test::More->builder->no_ending(1); + +require MyOverload; +my $cmp = Overloaded::Compare->new("foo", 42); +my $ify = Overloaded::Ify->new("bar", 23); + +my @Tests = ( + [1, '==', 1], + [1, '==', 2], + ["a", "eq", "b"], + ["a", "eq", "a"], + [1, "+", 1], + [1, "-", 1], + + [$cmp, '==', 42], + [$cmp, 'eq', "foo"], + [$ify, 'eq', "bar"], + [$ify, "==", 23], +); + +plan tests => scalar @Tests; +$TB->plan(tests => @Tests * 2); + +for my $test (@Tests) { + try_cmp_ok(@$test); +} diff --git a/cpan/Test-Simple/t/diag.t b/cpan/Test-Simple/t/diag.t new file mode 100644 index 0000000000..f5cb437d54 --- /dev/null +++ b/cpan/Test-Simple/t/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/died.t b/cpan/Test-Simple/t/died.t new file mode 100644 index 0000000000..b4ee2fbbff --- /dev/null +++ b/cpan/Test-Simple/t/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/dont_overwrite_die_handler.t b/cpan/Test-Simple/t/dont_overwrite_die_handler.t new file mode 100644 index 0000000000..0657a06ca3 --- /dev/null +++ b/cpan/Test-Simple/t/dont_overwrite_die_handler.t @@ -0,0 +1,19 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +# Make sure this is in place before Test::More is loaded. +my $handler_called; +BEGIN { + $SIG{__DIE__} = sub { $handler_called++ }; +} + +use Test::More tests => 2; + +ok !eval { die }; +is $handler_called, 1, 'existing DIE handler not overridden'; diff --git a/cpan/Test-Simple/t/eq_set.t b/cpan/Test-Simple/t/eq_set.t new file mode 100644 index 0000000000..fbdc52db1f --- /dev/null +++ b/cpan/Test-Simple/t/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/exit.t b/cpan/Test-Simple/t/exit.t new file mode 100644 index 0000000000..95661eef07 --- /dev/null +++ b/cpan/Test-Simple/t/exit.t @@ -0,0 +1,114 @@ +#!/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' ) { + # VMS can't use its own $^X in a system call until almost 5.8 + $Perl = "MCR $^X" if $] < 5.007003; + + # Quiet noisy 'SYS$ABORT' + $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, + ); + +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/explain.t b/cpan/Test-Simple/t/explain.t new file mode 100644 index 0000000000..cf2f550e95 --- /dev/null +++ b/cpan/Test-Simple/t/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/extra.t b/cpan/Test-Simple/t/extra.t new file mode 100644 index 0000000000..57235be195 --- /dev/null +++ b/cpan/Test-Simple/t/extra.t @@ -0,0 +1,59 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +# Can't use Test.pm, that's a 5.005 thing. +package My::Test; + +# This has to be a require or else the END block below runs before +# Test::Builder's own and the ending diagnostics don't come out right. +require Test::Builder; +my $TB = Test::Builder->create; +$TB->plan(tests => 2); + + +package main; + +require Test::Simple; + +chdir 't'; +push @INC, '../t/lib/'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; + +Test::Simple->import(tests => 3); + +#line 30 +ok(1, 'Foo'); +ok(0, 'Bar'); +ok(1, 'Yar'); +ok(1, 'Car'); +ok(0, 'Sar'); + +END { + $TB->is_eq($$out, <<OUT); +1..3 +ok 1 - Foo +not ok 2 - Bar +ok 3 - Yar +ok 4 - Car +not ok 5 - Sar +OUT + + $TB->is_eq($$err, <<ERR); +# Failed test 'Bar' +# at $0 line 31. +# Failed test 'Sar' +# at $0 line 34. +# Looks like you planned 3 tests but ran 5. +# Looks like you failed 2 tests of 5 run. +ERR + + exit 0; +} diff --git a/cpan/Test-Simple/t/extra_one.t b/cpan/Test-Simple/t/extra_one.t new file mode 100644 index 0000000000..d77404e15d --- /dev/null +++ b/cpan/Test-Simple/t/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/fail-like.t b/cpan/Test-Simple/t/fail-like.t new file mode 100644 index 0000000000..0ea5fab3da --- /dev/null +++ b/cpan/Test-Simple/t/fail-like.t @@ -0,0 +1,74 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +# There was a bug with like() involving a qr// not failing properly. +# This tests against that. + +use strict; + + +# Can't use Test.pm, that's a 5.005 thing. +package My::Test; + +# This has to be a require or else the END block below runs before +# Test::Builder's own and the ending diagnostics don't come out right. +require Test::Builder; +my $TB = Test::Builder->create; +$TB->plan(tests => 4); + + +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); +local $ENV{HARNESS_ACTIVE} = 0; + + +package main; + +require Test::More; +Test::More->import(tests => 1); + +{ + eval q{ like( "foo", qr/that/, 'is foo like that' ); }; + + $TB->is_eq($out->read, <<OUT, 'failing output'); +1..1 +not ok 1 - is foo like that +OUT + + my $err_re = <<ERR; +# Failed test 'is foo like that' +# at .* line 1\. +# 'foo' +# doesn't match '\\(\\?-xism:that\\)' +ERR + + $TB->like($err->read, qr/^$err_re$/, 'failing errors'); +} + +{ + # line 59 + 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 59. +# 'not a regex' doesn't look much like a regex to me. +OUT + +} + +END { + # Test::More thinks it failed. Override that. + exit(scalar grep { !$_ } $TB->summary); +} diff --git a/cpan/Test-Simple/t/fail-more.t b/cpan/Test-Simple/t/fail-more.t new file mode 100644 index 0000000000..423e216488 --- /dev/null +++ b/cpan/Test-Simple/t/fail-more.t @@ -0,0 +1,511 @@ +#!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 => 78); + +sub like ($$;$) { + $TB->like(@_); +} + +sub is ($$;$) { + $TB->is_eq(@_); +} + +sub main::out_ok ($$) { + $TB->is_eq( $out->read, shift ); + $TB->is_eq( $err->read, shift ); +} + +sub main::out_like ($$) { + my($output, $failure) = @_; + + $TB->like( $out->read, qr/$output/ ); + $TB->like( $err->read, qr/$failure/ ); +} + + +package main; + +require Test::More; +our $TODO; +my $Total = 37; +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 +ERR + +#line 238 +isa_ok(bless([], "Foo"), "Wibble"); +out_ok( <<OUT, <<ERR ); +not ok - The object isa Wibble +OUT +# Failed test 'The object isa Wibble' +# at $0 line 238. +# The object isn't a 'Wibble' it's a 'Foo' +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 class or reference +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 - The reference isa HASH +OUT +# Failed test 'The reference isa HASH' +# at $0 line 268. +# The reference isn't a 'HASH' it's a 'ARRAY' +ERR + +#line 278 +new_ok(undef); +out_like( <<OUT, <<ERR ); +not ok - new\\(\\) died +OUT +# Failed test '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 - new\\(\\) died +OUT +# Failed test '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 - The object isa Foo +OUT +# Failed test 'The object isa Foo' +# at $0 line 303. +# The object isn't defined +ERR + +# line 313 +new_ok( "Bar" ); +out_ok( <<OUT, <<ERR ); +not ok - The object isa Bar +OUT +# Failed test 'The object isa Bar' +# at $0 line 313. +# The object isn't a 'Bar' it's a 'HASH' +ERR + +#line 323 +new_ok( "Baz" ); +out_ok( <<OUT, <<ERR ); +not ok - The object isa Baz +OUT +# Failed test 'The object isa Baz' +# at $0 line 323. +# The object isn't a 'Baz' it's a 'Wibble' +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' it's a 'Wibble' +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 404 + cmp_ok( 42, '==', "foo", ' == with strings' ); + out_ok( <<OUT, <<ERR ); +not ok - == with strings +OUT +# Failed test ' == with strings' +# at $0 line 404. +# got: 42 +# expected: foo +ERR + My::Test::like( + $warnings, + qr/^Argument "foo" isn't numeric in .* at cmp_ok \[from $Filename line 404\] line 1\.\n$/ + ); + $warnings = ''; +} + + +{ + my $warnings = ''; + local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; + +#line 426 + 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 426. +# got: undef +# expected: '' +ERR + } + + My::Test::like( + $warnings, + qr/^Use of uninitialized value.* in string ne at cmp_ok \[from $Filename line 426\] line 1\.\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/fail.t b/cpan/Test-Simple/t/fail.t new file mode 100644 index 0000000000..ccf0c74893 --- /dev/null +++ b/cpan/Test-Simple/t/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/fail_one.t b/cpan/Test-Simple/t/fail_one.t new file mode 100644 index 0000000000..61d7c081ff --- /dev/null +++ b/cpan/Test-Simple/t/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/filehandles.t b/cpan/Test-Simple/t/filehandles.t new file mode 100644 index 0000000000..f7dad5d7ea --- /dev/null +++ b/cpan/Test-Simple/t/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/fork.t b/cpan/Test-Simple/t/fork.t new file mode 100644 index 0000000000..55d7aec1f9 --- /dev/null +++ b/cpan/Test-Simple/t/fork.t @@ -0,0 +1,32 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::More; +use Config; + +my $Can_Fork = $Config{d_fork} || + (($^O eq 'MSWin32' || $^O eq 'NetWare') and + $Config{useithreads} and + $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ + ); + +if( !$Can_Fork ) { + plan skip_all => "This system cannot fork"; +} +else { + plan tests => 1; +} + +if( fork ) { # parent + pass("Only the parent should process the ending, not the child"); +} +else { + exit; # child +} + diff --git a/cpan/Test-Simple/t/harness_active.t b/cpan/Test-Simple/t/harness_active.t new file mode 100644 index 0000000000..7b027a7b40 --- /dev/null +++ b/cpan/Test-Simple/t/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/import.t b/cpan/Test-Simple/t/import.t new file mode 100644 index 0000000000..68a36138bc --- /dev/null +++ b/cpan/Test-Simple/t/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/is_deeply_dne_bug.t b/cpan/Test-Simple/t/is_deeply_dne_bug.t new file mode 100644 index 0000000000..f4578a6460 --- /dev/null +++ b/cpan/Test-Simple/t/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/is_deeply_fail.t b/cpan/Test-Simple/t/is_deeply_fail.t new file mode 100644 index 0000000000..bd9b634233 --- /dev/null +++ b/cpan/Test-Simple/t/is_deeply_fail.t @@ -0,0 +1,371 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; + +use Test::Builder; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); +Test::Builder->new->no_header(1); +Test::Builder->new->no_ending(1); +local $ENV{HARNESS_ACTIVE} = 0; + + +# Can't use Test.pm, that's a 5.005 thing. +package main; + + +my $TB = Test::Builder->create; +$TB->plan(tests => 73); + +# Utility testing functions. +sub ok ($;$) { + return $TB->ok(@_); +} + +sub is ($$;$) { + my($this, $that, $name) = @_; + + my $ok = $TB->is_eq($$this, $that, $name); + + $$this = ''; + + return $ok; +} + +sub like ($$;$) { + my($this, $regex, $name) = @_; + $regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s; + + my $ok = $TB->like($$this, $regex, $name); + + $$this = ''; + + return $ok; +} + + +require Test::More; +Test::More->import(tests => 11, import => ['is_deeply']); + +my $Filename = quotemeta $0; + +#line 68 +ok !is_deeply('foo', 'bar', 'plain strings'); +is( $out, "not ok 1 - plain strings\n", 'plain strings' ); +is( $err, <<ERR, ' right diagnostic' ); +# Failed test 'plain strings' +# at $0 line 68. +# got: 'foo' +# expected: 'bar' +ERR + + +#line 78 +ok !is_deeply({}, [], 'different types'); +is( $out, "not ok 2 - different types\n", 'different types' ); +like( $err, <<ERR, ' right diagnostic' ); +# Failed test 'different types' +# at $Filename line 78. +# Structures begin differing at: +# \\\$got = HASH\\(0x[0-9a-f]+\\) +# \\\$expected = ARRAY\\(0x[0-9a-f]+\\) +ERR + +#line 88 +ok !is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values'); +is( $out, "not ok 3 - hashes with different values\n", + 'hashes with different values' ); +is( $err, <<ERR, ' right diagnostic' ); +# Failed test 'hashes with different values' +# at $0 line 88. +# Structures begin differing at: +# \$got->{this} = '42' +# \$expected->{this} = '43' +ERR + +#line 99 +ok !is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys'); +is( $out, "not ok 4 - hashes with different keys\n", + 'hashes with different keys' ); +is( $err, <<ERR, ' right diagnostic' ); +# Failed test 'hashes with different keys' +# at $0 line 99. +# Structures begin differing at: +# \$got->{this} = Does not exist +# \$expected->{this} = '42' +ERR + +#line 110 +ok !is_deeply([1..9], [1..10], 'arrays of different length'); +is( $out, "not ok 5 - arrays of different length\n", + 'arrays of different length' ); +is( $err, <<ERR, ' right diagnostic' ); +# Failed test 'arrays of different length' +# at $0 line 110. +# Structures begin differing at: +# \$got->[9] = Does not exist +# \$expected->[9] = '10' +ERR + +#line 121 +ok !is_deeply([undef, undef], [undef], 'arrays of undefs' ); +is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' ); +is( $err, <<ERR, ' right diagnostic' ); +# Failed test 'arrays of undefs' +# at $0 line 121. +# Structures begin differing at: +# \$got->[1] = undef +# \$expected->[1] = Does not exist +ERR + +#line 131 +ok !is_deeply({ foo => undef }, {}, 'hashes of undefs' ); +is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' ); +is( $err, <<ERR, ' right diagnostic' ); +# Failed test 'hashes of undefs' +# at $0 line 131. +# Structures begin differing at: +# \$got->{foo} = undef +# \$expected->{foo} = Does not exist +ERR + +#line 141 +ok !is_deeply(\42, \23, 'scalar refs'); +is( $out, "not ok 8 - scalar refs\n", 'scalar refs' ); +is( $err, <<ERR, ' right diagnostic' ); +# Failed test 'scalar refs' +# at $0 line 141. +# Structures begin differing at: +# \${ \$got} = '42' +# \${\$expected} = '23' +ERR + +#line 151 +ok !is_deeply([], \23, 'mixed scalar and array refs'); +is( $out, "not ok 9 - mixed scalar and array refs\n", + 'mixed scalar and array refs' ); +like( $err, <<ERR, ' right diagnostic' ); +# Failed test 'mixed scalar and array refs' +# at $Filename line 151. +# Structures begin differing at: +# \\\$got = ARRAY\\(0x[0-9a-f]+\\) +# \\\$expected = SCALAR\\(0x[0-9a-f]+\\) +ERR + + +my($a1, $a2, $a3); +$a1 = \$a2; $a2 = \$a3; +$a3 = 42; + +my($b1, $b2, $b3); +$b1 = \$b2; $b2 = \$b3; +$b3 = 23; + +#line 173 +ok !is_deeply($a1, $b1, 'deep scalar refs'); +is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' ); +is( $err, <<ERR, ' right diagnostic' ); +# Failed test 'deep scalar refs' +# at $0 line 173. +# Structures begin differing at: +# \${\${ \$got}} = '42' +# \${\${\$expected}} = '23' +ERR + +# I don't know how to properly display this structure. +# $a2 = { foo => \$a3 }; +# $b2 = { foo => \$b3 }; +# is_deeply([$a1], [$b1], 'deep mixed scalar refs'); + +my $foo = { + this => [1..10], + that => { up => "down", left => "right" }, + }; + +my $bar = { + this => [1..10], + that => { up => "down", left => "right", foo => 42 }, + }; + +#line 198 +ok !is_deeply( $foo, $bar, 'deep structures' ); +ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); +is( $out, "not ok 11 - deep structures\n", 'deep structures' ); +is( $err, <<ERR, ' right diagnostic' ); +# Failed test 'deep structures' +# at $0 line 198. +# Structures begin differing at: +# \$got->{that}{foo} = Does not exist +# \$expected->{that}{foo} = '42' +ERR + + +#line 221 +my @tests = ([], + [qw(42)], + [qw(42 23), qw(42 23)] + ); + +foreach my $test (@tests) { + my $num_args = @$test; + + my $warning; + local $SIG{__WARN__} = sub { $warning .= join '', @_; }; + ok !is_deeply(@$test); + + like \$warning, + "/^is_deeply\\(\\) takes two or three args, you gave $num_args\.\n/"; +} + + +#line 240 +# [rt.cpan.org 6837] +ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""'; +ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); + + +#line 258 +# [rt.cpan.org 7031] +my $a = []; +ok !is_deeply($a, $a.''), "don't compare refs like strings"; +ok !is_deeply([$a], [$a.'']), " even deep inside"; + + +#line 265 +# [rt.cpan.org 7030] +ok !is_deeply( {}, {key => []} ), '[] could match non-existent values'; +ok !is_deeply( [], [[]] ); + + +#line 273 +$$err = $$out = ''; +ok !is_deeply( [\'a', 'b'], [\'a', 'c'] ); +is( $out, "not ok 20\n", 'scalar refs in an array' ); +is( $err, <<ERR, ' right diagnostic' ); +# Failed test at $0 line 274. +# Structures begin differing at: +# \$got->[1] = 'b' +# \$expected->[1] = 'c' +ERR + + +#line 285 +my $ref = \23; +ok !is_deeply( 23, $ref ); +is( $out, "not ok 21\n", 'scalar vs ref' ); +is( $err, <<ERR, ' right diagnostic'); +# Failed test at $0 line 286. +# Structures begin differing at: +# \$got = '23' +# \$expected = $ref +ERR + +#line 296 +ok !is_deeply( $ref, 23 ); +is( $out, "not ok 22\n", 'ref vs scalar' ); +is( $err, <<ERR, ' right diagnostic'); +# Failed test at $0 line 296. +# Structures begin differing at: +# \$got = $ref +# \$expected = '23' +ERR + +#line 306 +ok !is_deeply( undef, [] ); +is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' ); +like( $err, <<ERR, ' right diagnostic' ); +# Failed test at $Filename line 306\\. +# Structures begin differing at: +# \\\$got = undef +# \\\$expected = ARRAY\\(0x[0-9a-f]+\\) +ERR + + +# rt.cpan.org 8865 +{ + my $array = []; + my $hash = {}; + +#line 321 + ok !is_deeply( $array, $hash ); + is( $out, "not ok 24\n", 'is_deeply and different reference types' ); + is( $err, <<ERR, ' right diagnostic' ); +# Failed test at $0 line 321. +# Structures begin differing at: +# \$got = $array +# \$expected = $hash +ERR + +#line 332 + ok !is_deeply( [$array], [$hash] ); + is( $out, "not ok 25\n", 'nested different ref types' ); + is( $err, <<ERR, ' right diagnostic' ); +# Failed test at $0 line 332. +# Structures begin differing at: +# \$got->[0] = $array +# \$expected->[0] = $hash +ERR + + + # Overloaded object tests + { + my $foo = bless [], "Foo"; + my $bar = bless {}, "Bar"; + + { + package Bar; + "overload"->import(q[""] => sub { "wibble" }); + } + +#line 353 + ok !is_deeply( [$foo], [$bar] ); + is( $out, "not ok 26\n", 'string overloaded refs respected in diag' ); + is( $err, <<ERR, ' right diagnostic' ); +# Failed test at $0 line 353. +# Structures begin differing at: +# \$got->[0] = $foo +# \$expected->[0] = 'wibble' +ERR + + } +} + + +# rt.cpan.org 14746 +{ +# line 349 + ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs'; + is( $out, "not ok 27\n" ); + like( $err, <<ERR, ' right diagnostic' ); +# Failed test at $Filename line 349. +# Structures begin differing at: +# \\\$got = CODE\\(0x[0-9a-f]+\\) +# \\\$expected = CODE\\(0x[0-9a-f]+\\) +ERR + + + use Symbol; + my $glob1 = gensym; + my $glob2 = gensym; + +#line 357 + ok !is_deeply( $glob1, $glob2 ), 'typeglobs'; + is( $out, "not ok 28\n" ); + like( $err, <<ERR, ' right diagnostic' ); +# Failed test at $Filename line 357. +# Structures begin differing at: +# \\\$got = GLOB\\(0x[0-9a-f]+\\) +# \\\$expected = GLOB\\(0x[0-9a-f]+\\) +ERR + +} diff --git a/cpan/Test-Simple/t/is_deeply_with_threads.t b/cpan/Test-Simple/t/is_deeply_with_threads.t new file mode 100644 index 0000000000..9908ef6608 --- /dev/null +++ b/cpan/Test-Simple/t/is_deeply_with_threads.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl -w + +# Test to see if is_deeply() plays well with threads. + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use Config; + +BEGIN { + unless ( $] >= 5.008001 && $Config{'useithreads'} && + eval { require threads; 'threads'->import; 1; }) + { + print "1..0 # Skip no working threads\n"; + exit 0; + } + + unless ( $ENV{AUTHOR_TESTING} ) { + print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n"; + exit 0; + } +} +use Test::More; + +my $Num_Threads = 5; + +plan tests => $Num_Threads * 100 + 6; + + +sub do_one_thread { + my $kid = shift; + my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z', + 'hello', 's', 'thisisalongname', '1', '2', '3', + 'abc', 'xyz', '1234567890', 'm', 'n', 'p' ); + my @list2 = @list; + print "# kid $kid before is_deeply\n"; + + for my $j (1..100) { + is_deeply(\@list, \@list2); + } + print "# kid $kid exit\n"; + return 42; +} + +my @kids = (); +for my $i (1..$Num_Threads) { + my $t = threads->new(\&do_one_thread, $i); + print "# parent $$: continue\n"; + push(@kids, $t); +} +for my $t (@kids) { + print "# parent $$: waiting for join\n"; + my $rc = $t->join(); + cmp_ok( $rc, '==', 42, "threads exit status is $rc" ); +} + +pass("End of test"); diff --git a/cpan/Test-Simple/t/lib/Dev/Null.pm b/cpan/Test-Simple/t/lib/Dev/Null.pm new file mode 100644 index 0000000000..24ec07ab57 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Dev/Null.pm @@ -0,0 +1,8 @@ +package Dev::Null; + +use strict; + +sub TIEHANDLE { bless {}, shift } +sub PRINT { 1 } + +1; diff --git a/cpan/Test-Simple/t/lib/Dummy.pm b/cpan/Test-Simple/t/lib/Dummy.pm new file mode 100644 index 0000000000..cdff79d540 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Dummy.pm @@ -0,0 +1,6 @@ +package Dummy; + +use strict; +our $VERSION = '0.01'; + +1; diff --git a/cpan/Test-Simple/t/lib/MyOverload.pm b/cpan/Test-Simple/t/lib/MyOverload.pm new file mode 100644 index 0000000000..65f5ea5a7d --- /dev/null +++ b/cpan/Test-Simple/t/lib/MyOverload.pm @@ -0,0 +1,30 @@ +package Overloaded; ##no critic (Modules::RequireFilenameMatchesPackage) + +use strict; + +sub new { + my $class = shift; + bless { string => shift, num => shift }, $class; +} + +package Overloaded::Compare; + +use strict; +our @ISA = qw(Overloaded); + +# Sometimes objects have only comparison ops overloaded and nothing else. +# For example, DateTime objects. +use overload + q{eq} => sub { $_[0]->{string} eq $_[1] }, + q{==} => sub { $_[0]->{num} == $_[1] }; + +package Overloaded::Ify; + +use strict; +our @ISA = qw(Overloaded); + +use overload + q{""} => sub { $_[0]->{string} }, + q{0+} => sub { $_[0]->{num} }; + +1; diff --git a/cpan/Test-Simple/t/lib/NoExporter.pm b/cpan/Test-Simple/t/lib/NoExporter.pm new file mode 100644 index 0000000000..6273e32d74 --- /dev/null +++ b/cpan/Test-Simple/t/lib/NoExporter.pm @@ -0,0 +1,12 @@ +package NoExporter; + +use strict; +our $VERSION = 1.02; + +sub import { + shift; + die "NoExporter exports nothing. You asked for: @_" if @_; +} + +1; + diff --git a/cpan/Test-Simple/t/lib/SigDie.pm b/cpan/Test-Simple/t/lib/SigDie.pm new file mode 100644 index 0000000000..0774728d4e --- /dev/null +++ b/cpan/Test-Simple/t/lib/SigDie.pm @@ -0,0 +1,8 @@ +package SigDie; + +use strict; + +our $DIE; +$SIG{__DIE__} = sub { $DIE = $@ }; + +1; diff --git a/cpan/Test-Simple/t/lib/Test/Builder/NoOutput.pm b/cpan/Test-Simple/t/lib/Test/Builder/NoOutput.pm new file mode 100644 index 0000000000..d83db9f178 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Builder/NoOutput.pm @@ -0,0 +1,122 @@ +package Test::Builder::NoOutput; + +use strict; +use warnings; + +use base qw(Test::Builder); + + +=head1 NAME + +Test::Builder::NoOutput - A subclass of Test::Builder which prints nothing + +=head1 SYNOPSIS + + use Test::Builder::NoOutput; + + my $tb = Test::Builder::NoOutput->new; + + ...test as normal... + + my $output = $tb->read; + +=head1 DESCRIPTION + +This is a subclass of Test::Builder which traps all its output. +It is mostly useful for testing Test::Builder. + +=head3 read + + my $all_output = $tb->read; + my $output = $tb->read($stream); + +Returns all the output (including failure and todo output) collected +so far. It is destructive, each call to read clears the output +buffer. + +If $stream is given it will return just the output from that stream. +$stream's are... + + out output() + err failure_output() + todo todo_output() + all all outputs + +Defaults to 'all'. + +=cut + +my $Test = __PACKAGE__->new; + +sub create { + my $class = shift; + my $self = $class->SUPER::create(@_); + + my %outputs = ( + all => '', + out => '', + err => '', + todo => '', + ); + $self->{_outputs} = \%outputs; + + tie *OUT, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{out}; + tie *ERR, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{err}; + tie *TODO, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{todo}; + + $self->output(*OUT); + $self->failure_output(*ERR); + $self->todo_output(*TODO); + + return $self; +} + +sub read { + my $self = shift; + my $stream = @_ ? shift : 'all'; + + my $out = $self->{_outputs}{$stream}; + + $self->{_outputs}{$stream} = ''; + + # Clear all the streams if 'all' is read. + if( $stream eq 'all' ) { + my @keys = keys %{$self->{_outputs}}; + $self->{_outputs}{$_} = '' for @keys; + } + + return $out; +} + + +package Test::Builder::NoOutput::Tee; + +# A cheap implementation of IO::Tee. + +sub TIEHANDLE { + my($class, @refs) = @_; + + my @fhs; + for my $ref (@refs) { + my $fh = Test::Builder->_new_fh($ref); + push @fhs, $fh; + } + + my $self = [@fhs]; + return bless $self, $class; +} + +sub PRINT { + my $self = shift; + + print $_ @_ for @$self; +} + +sub PRINTF { + my $self = shift; + my $format = shift; + + printf $_ @_ for @$self; +} + +1; diff --git a/cpan/Test-Simple/t/lib/Test/Simple/Catch.pm b/cpan/Test-Simple/t/lib/Test/Simple/Catch.pm new file mode 100644 index 0000000000..9a2efb192d --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/Catch.pm @@ -0,0 +1,20 @@ +# For testing Test::Simple; +package Test::Simple::Catch; + +use strict; + +use Symbol; +use TieOut; +my( $out_fh, $err_fh ) = ( gensym, gensym ); +my $out = tie *$out_fh, 'TieOut'; +my $err = tie *$err_fh, 'TieOut'; + +use Test::Builder; +my $t = Test::Builder->new; +$t->output($out_fh); +$t->failure_output($err_fh); +$t->todo_output($err_fh); + +sub caught { return( $out, $err ) } + +1; diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/death.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/death.plx new file mode 100644 index 0000000000..e682ec08a2 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/death.plx @@ -0,0 +1,16 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +require Dev::Null; + +Test::Simple->import(tests => 5); +tie *STDERR, 'Dev::Null'; + +ok(1); +ok(1); +ok(1); +$! = 0; +die "This is a test"; diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/death_in_eval.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/death_in_eval.plx new file mode 100644 index 0000000000..269bffa802 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/death_in_eval.plx @@ -0,0 +1,22 @@ +require Test::Simple; +use Carp; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + +ok(1); +ok(1); +ok(1); +eval { + die "Foo"; +}; +ok(1); +eval "die 'Bar'"; +ok(1); + +eval { + croak "Moo"; +}; diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/death_with_handler.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/death_with_handler.plx new file mode 100644 index 0000000000..7dabb31d60 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/death_with_handler.plx @@ -0,0 +1,20 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 2); + +# Test we still get the right exit code despite having a die +# handler. +$SIG{__DIE__} = sub {}; + +require Dev::Null; +tie *STDERR, 'Dev::Null'; + +ok(1); +ok(1); + +$! = 0; +die "This is a test"; diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/exit.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/exit.plx new file mode 100644 index 0000000000..7f8ff73f75 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/exit.plx @@ -0,0 +1,3 @@ +require Test::Builder; + +exit 1; diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/extras.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/extras.plx new file mode 100644 index 0000000000..c9c89520aa --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/extras.plx @@ -0,0 +1,16 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + + +ok(1); +ok(1); +ok(1); +ok(1); +ok(0); +ok(1); +ok(0); diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/five_fail.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/five_fail.plx new file mode 100644 index 0000000000..c058e1f8f0 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/five_fail.plx @@ -0,0 +1,13 @@ +require Test::Simple; + +use lib 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + +ok(0); +ok(0); +ok(''); +ok(0); +ok(0); diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/last_minute_death.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/last_minute_death.plx new file mode 100644 index 0000000000..e3d01beeb7 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/last_minute_death.plx @@ -0,0 +1,19 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + +require Dev::Null; +tie *STDERR, 'Dev::Null'; + +ok(1); +ok(1); +ok(1); +ok(1); +ok(1); + +$! = 0; +die "This is a test"; diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/one_fail.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/one_fail.plx new file mode 100644 index 0000000000..99c720250d --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/one_fail.plx @@ -0,0 +1,14 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + + +ok(1); +ok(2); +ok(0); +ok(1); +ok(2); diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/pre_plan_death.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/pre_plan_death.plx new file mode 100644 index 0000000000..f72d3b65e5 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/pre_plan_death.plx @@ -0,0 +1,17 @@ +# ID 20020716.013, the exit code would become 0 if the test died +# before a plan. + +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +close STDERR; +die "Knife?"; + +Test::Simple->import(tests => 3); + +ok(1); +ok(1); +ok(1); diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/require.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/require.plx new file mode 100644 index 0000000000..1a06690d9d --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/require.plx @@ -0,0 +1 @@ +require Test::Simple; diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/success.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/success.plx new file mode 100644 index 0000000000..585d6c3d79 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/success.plx @@ -0,0 +1,13 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + +ok(1); +ok(5, 'yep'); +ok(3, 'beer'); +ok("wibble", "wibble"); +ok(1); diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/too_few.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/too_few.plx new file mode 100644 index 0000000000..bbc630ddce --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/too_few.plx @@ -0,0 +1,11 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + + +ok(1); +ok(1); diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/too_few_fail.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/too_few_fail.plx new file mode 100644 index 0000000000..9ca4517b66 --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/too_few_fail.plx @@ -0,0 +1,12 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + + +ok(0); +ok(1); +ok(0); diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/two_fail.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/two_fail.plx new file mode 100644 index 0000000000..e3d92296af --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/two_fail.plx @@ -0,0 +1,14 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(tests => 5); + + +ok(0); +ok(1); +ok(1); +ok(0); +ok(1); diff --git a/cpan/Test-Simple/t/lib/TieOut.pm b/cpan/Test-Simple/t/lib/TieOut.pm new file mode 100644 index 0000000000..a08a9116ba --- /dev/null +++ b/cpan/Test-Simple/t/lib/TieOut.pm @@ -0,0 +1,30 @@ +package TieOut; + +use strict; + +sub TIEHANDLE { + my $scalar = ''; + bless( \$scalar, $_[0] ); +} + +sub PRINT { + my $self = shift; + $$self .= join( '', @_ ); +} + +sub PRINTF { + my $self = shift; + my $fmt = shift; + $$self .= sprintf $fmt, @_; +} + +sub FILENO { } + +sub read { + my $self = shift; + my $data = $$self; + $$self = ''; + return $data; +} + +1; diff --git a/cpan/Test-Simple/t/missing.t b/cpan/Test-Simple/t/missing.t new file mode 100644 index 0000000000..3996b6de4b --- /dev/null +++ b/cpan/Test-Simple/t/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/new_ok.t b/cpan/Test-Simple/t/new_ok.t new file mode 100644 index 0000000000..d53f535d1c --- /dev/null +++ b/cpan/Test-Simple/t/new_ok.t @@ -0,0 +1,42 @@ +#!/usr/bin/perl -w + +use strict; + +use Test::More tests => 13; + +{ + package Bar; + + sub new { + my $class = shift; + return bless {@_}, $class; + } + + + package Foo; + our @ISA = qw(Bar); +} + +{ + my $obj = new_ok("Foo"); + is_deeply $obj, {}; + isa_ok $obj, "Foo"; + + $obj = new_ok("Bar"); + is_deeply $obj, {}; + isa_ok $obj, "Bar"; + + $obj = new_ok("Foo", [this => 42]); + is_deeply $obj, { this => 42 }; + isa_ok $obj, "Foo"; + + $obj = new_ok("Foo", [], "Foo"); + is_deeply $obj, {}; + isa_ok $obj, "Foo"; +} + +# And what if we give it nothing? +eval { + new_ok(); +}; +is $@, sprintf "new_ok() must be given at least a class at %s line %d.\n", $0, __LINE__ - 2; diff --git a/cpan/Test-Simple/t/no_plan.t b/cpan/Test-Simple/t/no_plan.t new file mode 100644 index 0000000000..5f392e40e1 --- /dev/null +++ b/cpan/Test-Simple/t/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/no_tests.t b/cpan/Test-Simple/t/no_tests.t new file mode 100644 index 0000000000..eafa38cacc --- /dev/null +++ b/cpan/Test-Simple/t/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/note.t b/cpan/Test-Simple/t/note.t new file mode 100644 index 0000000000..fb98fb4029 --- /dev/null +++ b/cpan/Test-Simple/t/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/overload.t b/cpan/Test-Simple/t/overload.t new file mode 100644 index 0000000000..a86103746b --- /dev/null +++ b/cpan/Test-Simple/t/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/overload_threads.t b/cpan/Test-Simple/t/overload_threads.t new file mode 100644 index 0000000000..379e347bae --- /dev/null +++ b/cpan/Test-Simple/t/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/plan.t b/cpan/Test-Simple/t/plan.t new file mode 100644 index 0000000000..0d3ce89edb --- /dev/null +++ b/cpan/Test-Simple/t/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("You tried to plan twice at %s line %d.\n", $0, __LINE__ - 1), + 'disallow double plan' ); +eval { plan 'no_plan' }; +is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ -1), + 'disallow changing plan' ); + +pass('Just testing plan()'); +pass('Testing it some more'); diff --git a/cpan/Test-Simple/t/plan_bad.t b/cpan/Test-Simple/t/plan_bad.t new file mode 100644 index 0000000000..179356dbc1 --- /dev/null +++ b/cpan/Test-Simple/t/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/plan_is_noplan.t b/cpan/Test-Simple/t/plan_is_noplan.t new file mode 100644 index 0000000000..1e696042ef --- /dev/null +++ b/cpan/Test-Simple/t/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/plan_no_plan.t b/cpan/Test-Simple/t/plan_no_plan.t new file mode 100644 index 0000000000..3111592e97 --- /dev/null +++ b/cpan/Test-Simple/t/plan_no_plan.t @@ -0,0 +1,40 @@ +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::More; + +BEGIN { + if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) { + plan skip_all => "Won't work with t/TEST"; + } +} + +plan 'no_plan'; + +pass('Just testing'); +ok(1, 'Testing again'); + +{ + my $warning = ''; + local $SIG{__WARN__} = sub { $warning = join "", @_ }; + SKIP: { + skip 'Just testing skip with no_plan'; + fail("So very failed"); + } + is( $warning, '', 'skip with no "how_many" ok with no_plan' ); + + + $warning = ''; + TODO: { + todo_skip "Just testing todo_skip"; + + fail("Just testing todo"); + die "todo_skip should prevent this"; + pass("Again"); + } + is( $warning, '', 'skip with no "how_many" ok with no_plan' ); +} diff --git a/cpan/Test-Simple/t/plan_shouldnt_import.t b/cpan/Test-Simple/t/plan_shouldnt_import.t new file mode 100644 index 0000000000..b6eb064244 --- /dev/null +++ b/cpan/Test-Simple/t/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/plan_skip_all.t b/cpan/Test-Simple/t/plan_skip_all.t new file mode 100644 index 0000000000..528df5f50d --- /dev/null +++ b/cpan/Test-Simple/t/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/require_ok.t b/cpan/Test-Simple/t/require_ok.t new file mode 100644 index 0000000000..463a007599 --- /dev/null +++ b/cpan/Test-Simple/t/require_ok.t @@ -0,0 +1,29 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use Test::More tests => 8; + +# Symbol and Class::Struct are both non-XS core modules back to 5.004. +# So they'll always be there. +require_ok("Symbol"); +ok( $INC{'Symbol.pm'}, "require_ok MODULE" ); + +require_ok("Class/Struct.pm"); +ok( $INC{'Class/Struct.pm'}, "require_ok FILE" ); + +# Its more trouble than its worth to try to create these filepaths to test +# through require_ok() so we cheat and use the internal logic. +ok !Test::More::_is_module_name('foo:bar'); +ok !Test::More::_is_module_name('foo/bar.thing'); +ok !Test::More::_is_module_name('Foo::Bar::'); +ok Test::More::_is_module_name('V'); diff --git a/cpan/Test-Simple/t/simple.t b/cpan/Test-Simple/t/simple.t new file mode 100644 index 0000000000..7297e9d6dd --- /dev/null +++ b/cpan/Test-Simple/t/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/skip.t b/cpan/Test-Simple/t/skip.t new file mode 100644 index 0000000000..f2ea9fbf20 --- /dev/null +++ b/cpan/Test-Simple/t/skip.t @@ -0,0 +1,98 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::More tests => 17; + +# If we skip with the same name, Test::Harness will report it back and +# we won't get lots of false bug reports. +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/; +} diff --git a/cpan/Test-Simple/t/skipall.t b/cpan/Test-Simple/t/skipall.t new file mode 100644 index 0000000000..5491be126e --- /dev/null +++ b/cpan/Test-Simple/t/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/tbm_doesnt_set_exported_to.t b/cpan/Test-Simple/t/tbm_doesnt_set_exported_to.t new file mode 100644 index 0000000000..8bdd17753b --- /dev/null +++ b/cpan/Test-Simple/t/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/thread_taint.t b/cpan/Test-Simple/t/thread_taint.t new file mode 100644 index 0000000000..ef7b89daef --- /dev/null +++ b/cpan/Test-Simple/t/thread_taint.t @@ -0,0 +1,5 @@ +#!/usr/bin/perl -w + +use Test::More tests => 1; + +ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' ); diff --git a/cpan/Test-Simple/t/threads.t b/cpan/Test-Simple/t/threads.t new file mode 100644 index 0000000000..42ba8c269c --- /dev/null +++ b/cpan/Test-Simple/t/threads.t @@ -0,0 +1,33 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Config; +BEGIN { + unless ( $] >= 5.008001 && $Config{'useithreads'} && + eval { require threads; 'threads'->import; 1; }) + { + print "1..0 # Skip: no working threads\n"; + exit 0; + } +} + +use strict; +use Test::Builder; + +my $Test = Test::Builder->new; +$Test->exported_to('main'); +$Test->plan(tests => 6); + +for(1..5) { + 'threads'->create(sub { + $Test->ok(1,"Each of these should app the test number") + })->join; +} + +$Test->is_num($Test->current_test(), 5,"Should be five"); diff --git a/cpan/Test-Simple/t/todo.t b/cpan/Test-Simple/t/todo.t new file mode 100644 index 0000000000..91861be3cb --- /dev/null +++ b/cpan/Test-Simple/t/todo.t @@ -0,0 +1,157 @@ +#!perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use Test::More; + +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()"; +} + +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/undef.t b/cpan/Test-Simple/t/undef.t new file mode 100644 index 0000000000..2e9201c3b4 --- /dev/null +++ b/cpan/Test-Simple/t/undef.t @@ -0,0 +1,98 @@ +#!/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 => 21; + +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' ); +warnings_like(qr/Use of uninitialized value.* at $Filename line 45\.\n/); + +eq_array( [undef, undef], [undef, 23] ); +no_warnings; + +eq_hash ( { foo => undef, bar => undef }, + { foo => undef, bar => 23 } ); +no_warnings; + +eq_set ( [undef, undef, 12], [29, undef, undef] ); +no_warnings; + + +eq_hash ( { foo => undef, bar => { baz => undef, moo => 23 } }, + { foo => undef, bar => { baz => undef, moo => 23 } } ); +no_warnings; + + +#line 64 +cmp_ok( undef, '<=', 2, ' undef <= 2' ); +warnings_like(qr/Use of uninitialized value.* at cmp_ok \[from $Filename line 64\] line 1\.\n/); + + + +my $tb = Test::More->builder; + +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; +} diff --git a/cpan/Test-Simple/t/use_ok.t b/cpan/Test-Simple/t/use_ok.t new file mode 100644 index 0000000000..4a62f3557e --- /dev/null +++ b/cpan/Test-Simple/t/use_ok.t @@ -0,0 +1,67 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = qw(../lib ../lib/Test/Simple/t/lib); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::More tests => 15; + +# Using Symbol because it's core and exports lots of stuff. +{ + package Foo::one; + ::use_ok("Symbol"); + ::ok( defined &gensym, 'use_ok() no args exports defaults' ); +} + +{ + package Foo::two; + ::use_ok("Symbol", qw(qualify)); + ::ok( !defined &gensym, ' one arg, defaults overriden' ); + ::ok( defined &qualify, ' right function exported' ); +} + +{ + package Foo::three; + ::use_ok("Symbol", qw(gensym ungensym)); + ::ok( defined &gensym && defined &ungensym, ' multiple args' ); +} + +{ + package Foo::four; + my $warn; local $SIG{__WARN__} = sub { $warn .= shift; }; + ::use_ok("constant", qw(foo bar)); + ::ok( defined &foo, 'constant' ); + ::is( $warn, undef, 'no warning'); +} + +{ + package Foo::five; + ::use_ok("Symbol", 1.02); +} + +{ + package Foo::six; + ::use_ok("NoExporter", 1.02); +} + +{ + package Foo::seven; + local $SIG{__WARN__} = sub { + # Old perls will warn on X.YY_ZZ style versions. Not our problem + warn @_ unless $_[0] =~ /^Argument "\d+\.\d+_\d+" isn't numeric/; + }; + ::use_ok("Test::More", 0.47); +} + +{ + package Foo::eight; + local $SIG{__DIE__}; + ::use_ok("SigDie"); + ::ok(defined $SIG{__DIE__}, ' SIG{__DIE__} preserved'); +} diff --git a/cpan/Test-Simple/t/useing.t b/cpan/Test-Simple/t/useing.t new file mode 100644 index 0000000000..c4ce507127 --- /dev/null +++ b/cpan/Test-Simple/t/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/utf8.t b/cpan/Test-Simple/t/utf8.t new file mode 100644 index 0000000000..c7e93c3ac2 --- /dev/null +++ b/cpan/Test-Simple/t/utf8.t @@ -0,0 +1,69 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = '../lib'; + } +} + +use strict; +use warnings; + +use Test::More skip_all => 'Not yet implemented'; + +my $have_perlio; +BEGIN { + # All together so Test::More sees the open discipline + $have_perlio = eval q[ + use PerlIO; + use open ':std', ':locale'; + use Test::More; + 1; + ]; +} + +use Test::More; + +if( !$have_perlio ) { + plan skip_all => "Don't have PerlIO"; +} +else { + plan tests => 5; +} + +SKIP: { + skip( "Need PerlIO for this feature", 3 ) + unless $have_perlio; + + my %handles = ( + output => \*STDOUT, + failure_output => \*STDERR, + todo_output => \*STDOUT + ); + + for my $method (keys %handles) { + my $src = $handles{$method}; + + my $dest = Test::More->builder->$method; + + is_deeply { map { $_ => 1 } PerlIO::get_layers($dest) }, + { map { $_ => 1 } PerlIO::get_layers($src) }, + "layers copied to $method"; + } +} + +SKIP: { + skip( "Can't test in general because their locale is unknown", 2 ) + unless $ENV{AUTHOR_TESTING}; + + my $uni = "\x{11e}"; + + my @warnings; + local $SIG{__WARN__} = sub { + push @warnings, @_; + }; + + is( $uni, $uni, "Testing $uni" ); + is_deeply( \@warnings, [] ); +} diff --git a/cpan/Test-Simple/t/versions.t b/cpan/Test-Simple/t/versions.t new file mode 100644 index 0000000000..e41e7ce3e0 --- /dev/null +++ b/cpan/Test-Simple/t/versions.t @@ -0,0 +1,21 @@ +#!/usr/bin/perl -w + +# Make sure all the modules have the same version +# +# TBT has its own version system. + +use strict; +use Test::More; + +require Test::Builder; +require Test::Builder::Module; +require Test::Simple; + +my $dist_version = $Test::More::VERSION; + +like( $dist_version, qr/^ \d+ \. \d+ $/x ); +is( $dist_version, $Test::Builder::VERSION, 'Test::Builder' ); +is( $dist_version, $Test::Builder::Module::VERSION, 'TB::Module' ); +is( $dist_version, $Test::Simple::VERSION, 'Test::Simple' ); + +done_testing(4); |