--- perl-5.10.0/lib/Test/Builder.bla/Module.pm 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/Builder/Module.pm 2008-04-06 17:26:10.000000000 +0200 @@ -1,13 +1,13 @@ package Test::Builder::Module; +use strict; + use Test::Builder; require Exporter; -@ISA = qw(Exporter); +our @ISA = qw(Exporter); -$VERSION = '0.72'; - -use strict; +our $VERSION = '0.80'; # 5.004's Exporter doesn't have export_to_level. my $_export_to_level = sub { @@ -83,6 +83,9 @@ import_extra(). sub import { my($class) = shift; + + # Don't run all this when loading ourself. + return 1 if $class eq 'Test::Builder::Module'; my $test = $class->builder; Common subdirectories: perl-5.10.0/lib/Test/Builder.bla/Tester and perl-5.10.0/lib/Test/Builder/Tester diff -up perl-5.10.0/lib/Test/Builder.bla/Tester.pm perl-5.10.0/lib/Test/Builder/Tester.pm --- perl-5.10.0/lib/Test/Builder.bla/Tester.pm 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/Builder/Tester.pm 2008-04-06 17:26:21.000000000 +0200 @@ -1,8 +1,7 @@ package Test::Builder::Tester; use strict; -use vars qw(@EXPORT $VERSION @ISA); -$VERSION = "1.09"; +our $VERSION = "1.13"; use Test::Builder; use Symbol; @@ -56,9 +55,9 @@ my $t = Test::Builder->new; ### use Exporter; -@ISA = qw(Exporter); +our @ISA = qw(Exporter); -@EXPORT = qw(test_out test_err test_fail test_diag test_test line_num); +our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num); # _export_to_level and import stolen directly from Test::More. I am # the king of cargo cult programming ;-) @@ -188,7 +187,7 @@ output filehandles) =cut -sub test_out(@) +sub test_out { # do we need to do any setup? _start_testing() unless $testing; @@ -196,7 +195,7 @@ sub test_out(@) $out->expect(@_) } -sub test_err(@) +sub test_err { # do we need to do any setup? _start_testing() unless $testing; @@ -549,36 +548,36 @@ sub complaint if (Test::Builder::Tester::color) { # get color - eval "require Term::ANSIColor"; + eval { require Term::ANSIColor }; unless ($@) { - # colours + # colours - my $green = Term::ANSIColor::color("black"). - Term::ANSIColor::color("on_green"); + my $green = Term::ANSIColor::color("black"). + Term::ANSIColor::color("on_green"); my $red = Term::ANSIColor::color("black"). Term::ANSIColor::color("on_red"); - my $reset = Term::ANSIColor::color("reset"); + my $reset = Term::ANSIColor::color("reset"); - # work out where the two strings start to differ - my $char = 0; - $char++ while substr($got, $char, 1) eq substr($wanted, $char, 1); - - # get the start string and the two end strings - my $start = $green . substr($wanted, 0, $char); - my $gotend = $red . substr($got , $char) . $reset; - my $wantedend = $red . substr($wanted, $char) . $reset; - - # make the start turn green on and off - $start =~ s/\n/$reset\n$green/g; - - # make the ends turn red on and off - $gotend =~ s/\n/$reset\n$red/g; - $wantedend =~ s/\n/$reset\n$red/g; - - # rebuild the strings - $got = $start . $gotend; - $wanted = $start . $wantedend; + # work out where the two strings start to differ + my $char = 0; + $char++ while substr($got, $char, 1) eq substr($wanted, $char, 1); + + # get the start string and the two end strings + my $start = $green . substr($wanted, 0, $char); + my $gotend = $red . substr($got , $char) . $reset; + my $wantedend = $red . substr($wanted, $char) . $reset; + + # make the start turn green on and off + $start =~ s/\n/$reset\n$green/g; + + # make the ends turn red on and off + $gotend =~ s/\n/$reset\n$red/g; + $wantedend =~ s/\n/$reset\n$red/g; + + # rebuild the strings + $got = $start . $gotend; + $wanted = $start . $wantedend; } } diff -up perl-5.10.0/lib/Test/Builder.pm.bla perl-5.10.0/lib/Test/Builder.pm --- perl-5.10.0/lib/Test/Builder.pm.bla 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/Builder.pm 2008-04-06 17:26:10.000000000 +0200 @@ -1,15 +1,10 @@ package Test::Builder; -use 5.004; - -# $^C was only introduced in 5.005-ish. We do this to prevent -# use of uninitialized value warnings in older perls. -$^C ||= 0; - +use 5.006; use strict; -use vars qw($VERSION); -$VERSION = '0.72'; -$VERSION = eval $VERSION; # make the alpha version come out as a number + +our $VERSION = '0.80'; +$VERSION = eval { $VERSION }; # make the alpha version come out as a number # Make Test::Builder thread-safe for ithreads. BEGIN { @@ -73,28 +68,15 @@ Test::Builder - Backend for building tes =head1 SYNOPSIS package My::Test::Module; - use Test::Builder; - require Exporter; - @ISA = qw(Exporter); - @EXPORT = qw(ok); - - my $Test = Test::Builder->new; - $Test->output('my_logfile'); - - sub import { - my($self) = shift; - my $pack = caller; + use base 'Test::Builder::Module'; - $Test->exported_to($pack); - $Test->plan(@_); - - $self->export_to_level(1, $self, 'ok'); - } + my $CLASS = __PACKAGE__; sub ok { my($test, $name) = @_; + my $tb = $CLASS->builder; - $Test->ok($test, $name); + $tb->ok($test, $name); } @@ -177,7 +159,6 @@ sub reset { # hash keys is just asking for pain. Also, it was documented. $Level = 1; - $self->{Test_Died} = 0; $self->{Have_Plan} = 0; $self->{No_Plan} = 0; $self->{Original_Pid} = $$; @@ -196,9 +177,11 @@ sub reset { $self->{No_Header} = 0; $self->{No_Ending} = 0; + $self->{TODO} = undef; + $self->_dup_stdhandles unless $^C; - return undef; + return; } =back @@ -210,25 +193,6 @@ are. You usually only want to call one =over 4 -=item B - - my $pack = $Test->exported_to; - $Test->exported_to($pack); - -Tells Test::Builder what package you exported your functions to. -This is important for getting TODO tests right. - -=cut - -sub exported_to { - my($self, $pack) = @_; - - if( defined $pack ) { - $self->{Exported_To} = $pack; - } - return $self->{Exported_To}; -} - =item B $Test->plan('no_plan'); @@ -360,6 +324,29 @@ sub skip_all { exit(0); } + +=item B + + my $pack = $Test->exported_to; + $Test->exported_to($pack); + +Tells Test::Builder what package you exported your functions to. + +This method isn't terribly useful since modules which share the same +Test::Builder object might get exported to different packages and only +the last one will be honored. + +=cut + +sub exported_to { + my($self, $pack) = @_; + + if( defined $pack ) { + $self->{Exported_To} = $pack; + } + return $self->{Exported_To}; +} + =back =head2 Running tests @@ -401,9 +388,12 @@ sub ok { Very confusing. ERR - my($pack, $file, $line) = $self->caller; + my $todo = $self->todo(); + + # Capture the value of $TODO for the rest of this ok() call + # so it can more easily be found by other routines. + local $self->{TODO} = $todo; - my $todo = $self->todo($pack); $self->_unoverload_str(\$todo); my $out; @@ -448,13 +438,14 @@ ERR my $msg = $todo ? "Failed (TODO)" : "Failed"; $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE}; - if( defined $name ) { - $self->diag(qq[ $msg test '$name'\n]); - $self->diag(qq[ at $file line $line.\n]); - } - else { - $self->diag(qq[ $msg test at $file line $line.\n]); - } + my(undef, $file, $line) = $self->caller; + if( defined $name ) { + $self->diag(qq[ $msg test '$name'\n]); + $self->diag(qq[ at $file line $line.\n]); + } + else { + $self->diag(qq[ $msg test at $file line $line.\n]); + } } return $test ? 1 : 0; @@ -584,6 +575,7 @@ sub _is_diag { } } + local $Level = $Level + 1; return $self->diag(sprintf <_caller_context; - # Yes, it has to look like this or 5.4.5 won't see the #line directive. + # Yes, it has to look like this or 5.4.5 won't see the #line + # directive. # Don't ask me, man, I just work here. $test = eval " $code" . "\$got $type \$expect;"; @@ -730,6 +723,8 @@ sub _cmp_diag { $got = defined $got ? "'$got'" : 'undef'; $expect = defined $expect ? "'$expect'" : 'undef'; + + local $Level = $Level + 1; return $self->diag(sprintf <diag(sprintf <{$attribute}; }; - no strict 'refs'; + no strict 'refs'; ## no critic *{__PACKAGE__.'::'.$method} = $code; } @@ -1332,10 +1341,9 @@ sub _new_fh { $fh = $file_or_fh; } else { - $fh = do { local *FH }; - open $fh, ">$file_or_fh" or + open $fh, ">", $file_or_fh or $self->croak("Can't open test output log $file_or_fh: $!"); - _autoflush($fh); + _autoflush($fh); } return $fh; @@ -1350,6 +1358,7 @@ sub _autoflush { } +my($Testout, $Testerr); sub _dup_stdhandles { my $self = shift; @@ -1357,28 +1366,46 @@ sub _dup_stdhandles { # Set everything to unbuffered else plain prints to STDOUT will # come out in the wrong order from our own prints. - _autoflush(\*TESTOUT); + _autoflush($Testout); _autoflush(\*STDOUT); - _autoflush(\*TESTERR); + _autoflush($Testerr); _autoflush(\*STDERR); - $self->output(\*TESTOUT); - $self->failure_output(\*TESTERR); - $self->todo_output(\*TESTOUT); + $self->output ($Testout); + $self->failure_output($Testerr); + $self->todo_output ($Testout); } my $Opened_Testhandles = 0; sub _open_testhandles { + my $self = shift; + return if $Opened_Testhandles; + # We dup STDOUT and STDERR so people can change them in their # test suites while still getting normal test output. - open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!"; - open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!"; + open( $Testout, ">&STDOUT") or die "Can't dup STDOUT: $!"; + open( $Testerr, ">&STDERR") or die "Can't dup STDERR: $!"; + +# $self->_copy_io_layers( \*STDOUT, $Testout ); +# $self->_copy_io_layers( \*STDERR, $Testerr ); + $Opened_Testhandles = 1; } +sub _copy_io_layers { + my($self, $src, $dst) = @_; + + $self->_try(sub { + require PerlIO; + my @src_layers = PerlIO::get_layers($src); + + binmode $dst, join " ", map ":$_", @src_layers if @src_layers; + }); +} + =item carp $tb->carp(@message); @@ -1558,9 +1585,10 @@ will be considered 'todo' (see Test::Mor details). Returns the reason (ie. the value of $TODO) if running as todo tests, false otherwise. -todo() is about finding the right package to look for $TODO in. It -uses the exported_to() package to find it. If that's not set, it's -pretty good at guessing the right package to look at based on $Level. +todo() is about finding the right package to look for $TODO in. It's +pretty good at guessing the right package to look at. It first looks for +the caller based on C<$Level + 1>, since C is usually called inside +a test function. As a last resort it will use C. Sometimes there is some confusion about where todo() should be looking for the $TODO variable. If you want to be sure, tell it explicitly @@ -1571,10 +1599,12 @@ what $pack to use. sub todo { my($self, $pack) = @_; - $pack = $pack || $self->exported_to || $self->caller($Level); + return $self->{TODO} if defined $self->{TODO}; + + $pack = $pack || $self->caller(1) || $self->exported_to; return 0 unless $pack; - no strict 'refs'; + no strict 'refs'; ## no critic return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'} : 0; } @@ -1587,6 +1617,8 @@ sub todo { Like the normal caller(), except it reports according to your level(). +C<$height> will be added to the level(). + =cut sub caller { @@ -1671,35 +1703,27 @@ sub _my_exit { =cut -$SIG{__DIE__} = sub { - # We don't want to muck with death in an eval, but $^S isn't - # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing - # with it. Instead, we use caller. This also means it runs under - # 5.004! - my $in_eval = 0; - for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) { - $in_eval = 1 if $sub =~ /^\(eval\)/; - } - $Test->{Test_Died} = 1 unless $in_eval; -}; - sub _ending { my $self = shift; + my $real_exit_code = $?; $self->_sanity_check(); # Don't bother with an ending if this is a forked copy. Only the parent # should do the ending. + if( $self->{Original_Pid} != $$ ) { + return; + } + # Exit if plan() was never called. This is so "require Test::Simple" # doesn't puke. + if( !$self->{Have_Plan} ) { + return; + } + # Don't do an ending if we bailed out. - if( ($self->{Original_Pid} != $$) or - (!$self->{Have_Plan} && !$self->{Test_Died}) or - $self->{Bailed_Out} - ) - { - _my_exit($?); - return; + if( $self->{Bailed_Out} ) { + return; } # Figure out if we passed or failed and print helpful messages. @@ -1749,7 +1773,7 @@ Looks like you failed $num_failed test$s FAIL } - if( $self->{Test_Died} ) { + if( $real_exit_code ) { $self->diag(<<"FAIL"); Looks like your test died just after $self->{Curr_Test}. FAIL @@ -1773,7 +1797,7 @@ FAIL elsif ( $self->{Skip_All} ) { _my_exit( 0 ) && return; } - elsif ( $self->{Test_Died} ) { + elsif ( $real_exit_code ) { $self->diag(<<'FAIL'); Looks like your test died before it could output anything. FAIL diff -up perl-5.10.0/lib/Test/More.pm.bla perl-5.10.0/lib/Test/More.pm --- perl-5.10.0/lib/Test/More.pm.bla 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/More.pm 2008-04-06 17:26:10.000000000 +0200 @@ -1,7 +1,6 @@ package Test::More; -use 5.004; - +use 5.006; use strict; @@ -16,7 +15,7 @@ sub _carp { use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO); -$VERSION = '0.72'; +$VERSION = '0.80'; $VERSION = eval $VERSION; # make the alpha version come out as a number use Test::Builder::Module; @@ -31,7 +30,7 @@ use Test::Builder::Module; plan can_ok isa_ok diag - BAIL_OUT + BAIL_OUT ); @@ -659,32 +658,35 @@ sub use_ok ($;@) { my($pack,$filename,$line) = caller; - local($@,$!,$SIG{__DIE__}); # isolate eval - + my $code; if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) { # probably a version check. Perl needs to see the bare number # for it to work with non-Exporter based modules. - eval <ok( !$@, "use $module;" ); + my($eval_result, $eval_error) = _eval($code, \@imports); + my $ok = $tb->ok( $eval_result, "use $module;" ); + unless( $ok ) { - chomp $@; + chomp $eval_error; $@ =~ s{^BEGIN failed--compilation aborted at .*$} {BEGIN failed--compilation aborted at $filename line $line.}m; $tb->diag(< require_ok($module); @@ -711,20 +727,20 @@ sub require_ok ($) { # Module names must be barewords, files not. $module = qq['$module'] unless _is_module_name($module); - local($!, $@, $SIG{__DIE__}); # isolate eval - local $SIG{__DIE__}; - eval <ok( !$@, "require $module;" ); + my($eval_result, $eval_error) = _eval($code); + my $ok = $tb->ok( $eval_result, "require $module;" ); unless( $ok ) { - chomp $@; + chomp $eval_error; $tb->diag(< This behavior may go away in fu =item Backwards compatibility -Test::More works with Perls as old as 5.004_05. +Test::More works with Perls as old as 5.6.0. =item Overloaded objects diff -up perl-5.10.0/lib/Test/Simple.pm.bla perl-5.10.0/lib/Test/Simple.pm --- perl-5.10.0/lib/Test/Simple.pm.bla 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple.pm 2008-04-06 17:26:10.000000000 +0200 @@ -4,7 +4,7 @@ use 5.004; use strict 'vars'; use vars qw($VERSION @ISA @EXPORT); -$VERSION = '0.72'; +$VERSION = '0.80'; $VERSION = eval $VERSION; # make the alpha version come out as a number use Test::Builder::Module; diff -up perl-5.10.0/lib/Test/Tutorial.pod.bla perl-5.10.0/lib/Test/Tutorial.pod diff -urN perl-5.10.0/lib/Test/Simple/t.bla/BEGIN_require_ok.t perl-5.10.0/lib/Test/Simple/t/BEGIN_require_ok.t --- perl-5.10.0/lib/Test/Simple/t.bla/BEGIN_require_ok.t 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/BEGIN_require_ok.t 2007-12-04 04:32:40.000000000 +0100 @@ -0,0 +1,24 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::More; + +my $result; +BEGIN { + eval { + require_ok("Wibble"); + }; + $result = $@; +} + +plan tests => 1; +like $result, '/^You tried to run a test without a plan/'; diff -urN perl-5.10.0/lib/Test/Simple/t.bla/BEGIN_use_ok.t perl-5.10.0/lib/Test/Simple/t/BEGIN_use_ok.t --- perl-5.10.0/lib/Test/Simple/t.bla/BEGIN_use_ok.t 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/BEGIN_use_ok.t 2007-09-20 05:16:02.000000000 +0200 @@ -0,0 +1,28 @@ +#!/usr/bin/perl -w + +# [rt.cpan.org 28345] +# +# A use_ok() inside a BEGIN block lacking a plan would be silently ignored. + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::More; + +my $result; +BEGIN { + eval { + use_ok("Wibble"); + }; + $result = $@; +} + +plan tests => 1; +like $result, '/^You tried to run a test without a plan/'; diff -urN perl-5.10.0/lib/Test/Simple/t.bla/dont_overwrite_die_handler.t perl-5.10.0/lib/Test/Simple/t/dont_overwrite_die_handler.t --- perl-5.10.0/lib/Test/Simple/t.bla/dont_overwrite_die_handler.t 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/dont_overwrite_die_handler.t 2008-02-24 04:33:47.000000000 +0100 @@ -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 -urN perl-5.10.0/lib/Test/Simple/t.bla/exit.t perl-5.10.0/lib/Test/Simple/t/exit.t --- perl-5.10.0/lib/Test/Simple/t.bla/exit.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/exit.t 2008-02-24 04:29:39.000000000 +0100 @@ -25,18 +25,9 @@ exit 0; } -my $test_num = 1; -# Utility testing functions. -sub ok ($;$) { - my($test, $name) = @_; - my $ok = ''; - $ok .= "not " unless $test; - $ok .= "ok $test_num"; - $ok .= " - $name" if defined $name; - $ok .= "\n"; - print $ok; - $test_num++; -} +require Test::Builder; +my $TB = Test::Builder->create(); +$TB->level(0); package main; @@ -59,10 +50,11 @@ 'pre_plan_death.plx' => ['not zero', 'not zero'], 'death_in_eval.plx' => [0, 0], 'require.plx' => [0, 0], - 'exit.plx' => [1, 4], + 'death_with_handler.plx' => [255, 4], + 'exit.plx' => [1, 4], ); -print "1..".keys(%Tests)."\n"; +$TB->plan( tests => scalar keys(%Tests) ); eval { require POSIX; &POSIX::WEXITSTATUS(0) }; if( $@ ) { @@ -93,12 +85,12 @@ my $actual_exit = exitstatus($wait_stat); if( $exit_code eq 'not zero' ) { - My::Test::ok( $actual_exit != 0, + $TB->isnt_num( $actual_exit, 0, "$test_name exited with $actual_exit ". "(expected $exit_code)"); } else { - My::Test::ok( $actual_exit == $exit_code, + $TB->is_num( $actual_exit, $exit_code, "$test_name exited with $actual_exit ". "(expected $exit_code)"); } diff -urN perl-5.10.0/lib/Test/Simple/t.bla/filehandles.t perl-5.10.0/lib/Test/Simple/t/filehandles.t --- perl-5.10.0/lib/Test/Simple/t.bla/filehandles.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/filehandles.t 2008-02-29 11:07:33.000000000 +0100 @@ -3,19 +3,16 @@ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = '../lib'; + @INC = ('../lib', 'lib'); } } +use lib 't/lib'; use Test::More tests => 1; +use Dev::Null; tie *STDOUT, "Dev::Null" or die $!; print "not ok 1\n"; # this should not print. pass 'STDOUT can be mucked with'; - -package Dev::Null; - -sub TIEHANDLE { bless {} } -sub PRINT { 1 } diff -urN perl-5.10.0/lib/Test/Simple/t.bla/is_deeply_with_threads.t perl-5.10.0/lib/Test/Simple/t/is_deeply_with_threads.t --- perl-5.10.0/lib/Test/Simple/t.bla/is_deeply_with_threads.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/is_deeply_with_threads.t 2008-02-24 04:12:32.000000000 +0100 @@ -22,12 +22,17 @@ 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 + 5; +plan tests => $Num_Threads * 100 + 6; sub do_one_thread { @@ -56,3 +61,5 @@ my $rc = $t->join(); cmp_ok( $rc, '==', 42, "threads exit status is $rc" ); } + +pass("End of test"); diff -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Dev/Null.pm perl-5.10.0/lib/Test/Simple/t/lib/Dev/Null.pm --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Dev/Null.pm 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Dev/Null.pm 2008-02-24 04:44:15.000000000 +0100 @@ -0,0 +1,6 @@ +package Dev::Null; + +sub TIEHANDLE { bless {} } +sub PRINT { 1 } + +1; diff -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/NoExporter.pm perl-5.10.0/lib/Test/Simple/t/lib/NoExporter.pm --- perl-5.10.0/lib/Test/Simple/t.bla/lib/NoExporter.pm 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/NoExporter.pm 2008-02-24 04:03:27.000000000 +0100 @@ -0,0 +1,10 @@ +package NoExporter; + +$VERSION = 1.02; +sub import { + shift; + die "NoExporter exports nothing. You asked for: @_" if @_; +} + +1; + diff -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/Catch.pm perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/Catch.pm --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/Catch.pm 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/Catch.pm 2008-02-24 04:03:15.000000000 +0100 @@ -0,0 +1,18 @@ +# For testing Test::Simple; +package Test::Simple::Catch; + +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 -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/death_in_eval.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death_in_eval.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/death_in_eval.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death_in_eval.plx 2006-08-31 07:24:16.000000000 +0200 @@ -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 -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/death.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/death.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death.plx 2008-02-24 05:39:20.000000000 +0100 @@ -0,0 +1,15 @@ +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); +die "This is a test"; diff -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/death_with_handler.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death_with_handler.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/death_with_handler.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death_with_handler.plx 2008-02-24 05:38:55.000000000 +0100 @@ -0,0 +1,18 @@ +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); +die "This is a test"; diff -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/exit.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/exit.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/exit.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/exit.plx 2006-08-31 07:24:17.000000000 +0200 @@ -0,0 +1,3 @@ +require Test::Builder; + +exit 1; diff -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/extras.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/extras.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/extras.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/extras.plx 2006-08-31 07:24:16.000000000 +0200 @@ -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 -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/five_fail.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/five_fail.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/five_fail.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/five_fail.plx 2006-08-31 07:24:16.000000000 +0200 @@ -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 -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/last_minute_death.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/last_minute_death.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/last_minute_death.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/last_minute_death.plx 2008-02-24 05:39:07.000000000 +0100 @@ -0,0 +1,18 @@ +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); + +die "This is a test"; diff -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/one_fail.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/one_fail.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/one_fail.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/one_fail.plx 2006-08-31 07:24:17.000000000 +0200 @@ -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 -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/pre_plan_death.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/pre_plan_death.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/pre_plan_death.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/pre_plan_death.plx 2006-08-31 07:24:16.000000000 +0200 @@ -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 -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/require.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/require.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/require.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/require.plx 2006-08-31 07:24:17.000000000 +0200 @@ -0,0 +1 @@ +require Test::Simple; diff -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/success.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/success.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/success.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/success.plx 2006-08-31 07:24:16.000000000 +0200 @@ -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 -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/too_few_fail.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/too_few_fail.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/too_few_fail.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/too_few_fail.plx 2006-08-31 07:24:16.000000000 +0200 @@ -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); \ No newline at end of file diff -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/too_few.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/too_few.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/too_few.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/too_few.plx 2006-08-31 07:24:16.000000000 +0200 @@ -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 -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/two_fail.plx perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/two_fail.plx --- perl-5.10.0/lib/Test/Simple/t.bla/lib/Test/Simple/sample_tests/two_fail.plx 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/Test/Simple/sample_tests/two_fail.plx 2006-08-31 07:24:16.000000000 +0200 @@ -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 -urN perl-5.10.0/lib/Test/Simple/t.bla/lib/TieOut.pm perl-5.10.0/lib/Test/Simple/t/lib/TieOut.pm --- perl-5.10.0/lib/Test/Simple/t.bla/lib/TieOut.pm 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/lib/TieOut.pm 2008-02-24 04:03:15.000000000 +0100 @@ -0,0 +1,28 @@ +package TieOut; + +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 -urN perl-5.10.0/lib/Test/Simple/t.bla/maybe_regex.t perl-5.10.0/lib/Test/Simple/t/maybe_regex.t --- perl-5.10.0/lib/Test/Simple/t.bla/maybe_regex.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/maybe_regex.t 2008-02-24 05:08:29.000000000 +0100 @@ -11,22 +11,24 @@ } use strict; -use Test::More tests => 13; +use Test::More tests => 16; use Test::Builder; my $Test = Test::Builder->new; -SKIP: { - skip "qr// added in 5.005", 3 if $] < 5.005; +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'); - # 5.004 can't even see qr// or it pukes in compile. - eval q{ - 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'); - }; - die $@ if $@; +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' ); } { diff -urN perl-5.10.0/lib/Test/Simple/t.bla/pod-coverage.t perl-5.10.0/lib/Test/Simple/t/pod-coverage.t --- perl-5.10.0/lib/Test/Simple/t.bla/pod-coverage.t 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/pod-coverage.t 2007-03-14 01:21:10.000000000 +0100 @@ -0,0 +1,27 @@ +#!/usr/bin/perl -w + +use Test::More; + +# 1.08 added the coverage_class option. +eval "use Test::Pod::Coverage 1.08"; +plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; +eval "use Pod::Coverage::CountParents"; +plan skip_all => "Pod::Coverage::CountParents required for testing POD coverage" if $@; + +my @modules = Test::Pod::Coverage::all_modules(); +plan tests => scalar @modules; + +my %coverage_params = ( + "Test::Builder" => { + also_private => [ '^(share|lock|BAILOUT)$' ] + }, + "Test::More" => { + trustme => [ '^(skip|todo)$' ] + }, +); + +for my $module (@modules) { + pod_coverage_ok( $module, { coverage_class => 'Pod::Coverage::CountParents', + %{$coverage_params{$module} || {}} } + ); +} diff -urN perl-5.10.0/lib/Test/Simple/t.bla/pod.t perl-5.10.0/lib/Test/Simple/t/pod.t --- perl-5.10.0/lib/Test/Simple/t.bla/pod.t 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/pod.t 2006-10-24 23:08:10.000000000 +0200 @@ -0,0 +1,6 @@ +#!/usr/bin/perl -w + +use Test::More; +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok(); diff -urN perl-5.10.0/lib/Test/Simple/t.bla/reset.t perl-5.10.0/lib/Test/Simple/t/reset.t --- perl-5.10.0/lib/Test/Simple/t.bla/reset.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/reset.t 2008-02-24 05:31:07.000000000 +0100 @@ -16,6 +16,11 @@ use Test::Builder; my $tb = Test::Builder->new; + +my %Original_Output; +$Original_Output{$_} = $tb->$_ for qw(output failure_output todo_output); + + $tb->plan(tests => 14); $tb->level(0); @@ -66,11 +71,11 @@ ok( $tb->use_numbers == 1, 'use_numbers' ); ok( $tb->no_header == 0, 'no_header' ); ok( $tb->no_ending == 0, 'no_ending' ); -ok( fileno $tb->output == fileno *Test::Builder::TESTOUT, +ok( fileno $tb->output == fileno $Original_Output{output}, 'output' ); -ok( fileno $tb->failure_output == fileno *Test::Builder::TESTERR, +ok( fileno $tb->failure_output == fileno $Original_Output{failure_output}, 'failure_output' ); -ok( fileno $tb->todo_output == fileno *Test::Builder::TESTOUT, +ok( fileno $tb->todo_output == fileno $Original_Output{todo_output}, 'todo_output' ); ok( $tb->current_test == 0, 'current_test' ); ok( $tb->summary == 0, 'summary' ); diff -urN perl-5.10.0/lib/Test/Simple/t.bla/tbm_doesnt_set_exported_to.t perl-5.10.0/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t --- perl-5.10.0/lib/Test/Simple/t.bla/tbm_doesnt_set_exported_to.t 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t 2008-02-26 21:45:20.000000000 +0100 @@ -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()' +); \ No newline at end of file diff -urN perl-5.10.0/lib/Test/Simple/t.bla/todo.t perl-5.10.0/lib/Test/Simple/t/todo.t --- perl-5.10.0/lib/Test/Simple/t.bla/todo.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/todo.t 2008-02-27 10:37:18.000000000 +0100 @@ -9,7 +9,7 @@ use Test::More; -plan tests => 18; +plan tests => 19; $Why = 'Just testing the todo interface.'; @@ -69,11 +69,20 @@ # perl gets the line number a little wrong on the first # statement inside a block. 1 == 1; -#line 82 +#line 73 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 82\n", + "block at $0 line 73\n", 'todo_skip without $how_many warning' ); } + + +TODO: { + Test::More->builder->exported_to("Wibble"); + + local $TODO = "testing \$TODO with an incorrect exported_to()"; + + fail("Just testing todo"); +} diff -urN perl-5.10.0/lib/Test/Simple/t.bla/utf8.t perl-5.10.0/lib/Test/Simple/t/utf8.t --- perl-5.10.0/lib/Test/Simple/t.bla/utf8.t 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/lib/Test/Simple/t/utf8.t 2008-04-06 17:24:44.000000000 +0200 @@ -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 -up perl-5.10.0/t/lib/Test/Simple/sample_tests/death_in_eval.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/death_in_eval.plx diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/death.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/death.plx --- perl-5.10.0/t/lib/Test/Simple/sample_tests/death.plx.bla 2007-12-18 11:47:08.000000000 +0100 +++ perl-5.10.0/t/lib/Test/Simple/sample_tests/death.plx 2008-02-24 05:39:20.000000000 +0100 @@ -4,10 +4,12 @@ push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); +require Dev::Null; + Test::Simple->import(tests => 5); -close STDERR; +tie *STDERR, 'Dev::Null'; ok(1); ok(1); ok(1); -die "Knife?"; +die "This is a test"; diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/death_with_handler.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/death_with_handler.plx --- perl-5.10.0/t/lib/Test/Simple/sample_tests/death_with_handler.plx.bla 2008-09-16 14:55:33.000000000 +0200 +++ perl-5.10.0/t/lib/Test/Simple/sample_tests/death_with_handler.plx 2008-02-24 05:38:55.000000000 +0100 @@ -0,0 +1,18 @@ +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); +die "This is a test"; diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/exit.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/exit.plx diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/extras.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/extras.plx diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/five_fail.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/five_fail.plx diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/last_minute_death.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/last_minute_death.plx --- perl-5.10.0/t/lib/Test/Simple/sample_tests/last_minute_death.plx.bla 2007-12-18 11:47:08.000000000 +0100 +++ perl-5.10.0/t/lib/Test/Simple/sample_tests/last_minute_death.plx 2008-02-24 05:39:07.000000000 +0100 @@ -5,7 +5,9 @@ require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); -close STDERR; + +require Dev::Null; +tie *STDERR, 'Dev::Null'; ok(1); ok(1); @@ -13,4 +15,4 @@ ok(1); ok(1); ok(1); -die "Almost there..."; +die "This is a test"; diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/one_fail.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/one_fail.plx diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/pre_plan_death.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/pre_plan_death.plx diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/require.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/require.plx diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/success.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/success.plx diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/too_few_fail.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/too_few_fail.plx diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/too_few.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/too_few.plx diff -up perl-5.10.0/t/lib/Test/Simple/sample_tests/two_fail.plx.bla perl-5.10.0/t/lib/Test/Simple/sample_tests/two_fail.plx