diff options
Diffstat (limited to 'cpan/Test-Simple/t/Builder')
25 files changed, 921 insertions, 0 deletions
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"; |