rpms/perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity
d577113e98
perl/perl-5.10.0-TestSimple0.80.patch
Marcela Mašláňová c94bd23f43 - 462444 update Test::Simple to 0.80
2008-09-16 15:05:23 +00:00

1543 lines
46 KiB
Diff
Raw Blame History

--- 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<exported_to>
-
- 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<plan>
$Test->plan('no_plan');
@@ -360,6 +324,29 @@ sub skip_all {
exit(0);
}
+
+=item B<exported_to>
+
+ 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 <<DIAGNOSTIC, $got, $expect);
got: %s
expected: %s
@@ -705,7 +697,8 @@ sub cmp_ok {
my $code = $self->_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 <<DIAGNOSTIC, $got, $type, $expect);
%s
%s
@@ -925,7 +920,7 @@ sub maybe_regex {
my($re, $opts);
# Check for qr/foo/
- if( ref $regex eq 'Regexp' ) {
+ if( _is_qr($regex) ) {
$usable_regex = $regex;
}
# Check for '/foo/' or 'm,foo,'
@@ -937,7 +932,18 @@ sub maybe_regex {
}
return $usable_regex;
-};
+}
+
+
+sub _is_qr {
+ my $regex = shift;
+
+ # is_regexp() checks for regexes in a robust manner, say if they're
+ # blessed.
+ return re::is_regexp($regex) if defined &re::is_regexp;
+ return ref $regex eq 'Regexp';
+}
+
sub _regex_ok {
my($self, $this, $regex, $cmp, $name) = @_;
@@ -956,7 +962,8 @@ sub _regex_ok {
local($@, $!, $SIG{__DIE__}); # isolate eval
- # 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" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
@@ -970,6 +977,8 @@ $code" . q{$test = $this =~ /$usable_reg
unless( $ok ) {
$this = defined $this ? "'$this'" : 'undef';
my $match = $cmp eq '=~' ? "doesn't match" : "matches";
+
+ local $Level = $Level + 1;
$self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
%s
%13s '%s'
@@ -1145,7 +1154,7 @@ foreach my $attribute (qw(No_Header No_E
return $self->{$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<todo()> is usually called inside
+a test function. As a last resort it will use C<exported_to()>.
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 <<USE;
+ $code = <<USE;
package $pack;
use $module $imports[0];
+1;
USE
}
else {
- eval <<USE;
+ $code = <<USE;
package $pack;
-use $module \@imports;
+use $module \@{\$args[0]};
+1;
USE
}
- my $ok = $tb->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(<<DIAGNOSTIC);
Tried to use '$module'.
- Error: $@
+ Error: $eval_error
DIAGNOSTIC
}
@@ -692,6 +694,20 @@ DIAGNOSTIC
return $ok;
}
+
+sub _eval {
+ my($code) = shift;
+ my @args = @_;
+
+ # Work around oddities surrounding resetting of $@ by immediately
+ # storing it.
+ local($@,$!,$SIG{__DIE__}); # isolate eval
+ my $eval_result = eval $code;
+ my $eval_error = $@;
+
+ return($eval_result, $eval_error);
+}
+
=item B<require_ok>
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 <<REQUIRE;
+ my $code = <<REQUIRE;
package $pack;
require $module;
+1;
REQUIRE
- my $ok = $tb->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(<<DIAGNOSTIC);
Tried to require '$module'.
- Error: $@
+ Error: $eval_error
DIAGNOSTIC
}
@@ -1438,7 +1454,7 @@ B<NOTE> 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
Reference in New Issue View Git Blame Copy Permalink