Change 34376 by [EMAIL PROTECTED] on 2008/09/16 16:02:43
Integrate:
[ 31966]
Upgrade to Test::Simple 0.72
[perforce "already opened for branch" caused a change to be missed
from lib/Test/Simple/t/is_deeply_with_threads.t ]
[ 33968]
Just the Test::Builder changes from:
Integrate:
[ 32880]
Make new regex type be 'REGEXP' and make all core qr//'s be in class
Regexp (and related changes)
[ 33969]
Integrate:
[ 33340]
Fix Module-Build test that has been failing on Win32
since the upgrade of Test-Harness at #32659
[ 33391]
Upgrade to Test-Simple-0.75
[ 33394]
Upgrade to Test-Simple-0.78
[ 33395]
Hmmm...lib/Test/Builder.pm didn't get updated corectly. Unfortunately,
the tests didn't seem to catch this.
[ 33397]
Re-apply change #32880
[ 33398]
Context fix to make the test pass
[ 33688]
Sync with CPAN's version of the More.t test in Test::Simple
and delete duplicated test module Dummy.pm. (test now
expected to fail)
[ 33689]
Adapt properly More.t to run in the core
(like Module::Build does, for example)
[ 33970]
Integrate:
[ 33690]
Upgrade to Test::Simple 0.80, but keep locally modified More.t
[ 33691]
Add Dummy.pm from the base CPAN distribution,
and adjust tests accordingly
[ 33692]
Move the NoExporter test module under Test::Simple
(part of a plan to have modules self contained, and removing test
modules from t/lib)
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#442 integrate
... //depot/maint-5.8/perl/lib/Test/Builder.pm#12 integrate
... //depot/maint-5.8/perl/lib/Test/Builder/Module.pm#6 integrate
... //depot/maint-5.8/perl/lib/Test/Builder/Tester.pm#5 integrate
... //depot/maint-5.8/perl/lib/Test/More.pm#15 integrate
... //depot/maint-5.8/perl/lib/Test/Simple.pm#12 integrate
... //depot/maint-5.8/perl/lib/Test/Simple/Changes#12 integrate
... //depot/maint-5.8/perl/lib/Test/Simple/t/BEGIN_require_ok.t#1 branch
... //depot/maint-5.8/perl/lib/Test/Simple/t/More.t#8 integrate
... //depot/maint-5.8/perl/lib/Test/Simple/t/dont_overwrite_die_handler.t#1
branch
... //depot/maint-5.8/perl/lib/Test/Simple/t/exit.t#5 integrate
... //depot/maint-5.8/perl/lib/Test/Simple/t/filehandles.t#2 integrate
... //depot/maint-5.8/perl/lib/Test/Simple/t/is_deeply_with_threads.t#2
integrate
... //depot/maint-5.8/perl/lib/Test/Simple/t/lib/NoExporter.pm#1 branch
... //depot/maint-5.8/perl/lib/Test/Simple/t/maybe_regex.t#3 integrate
... //depot/maint-5.8/perl/lib/Test/Simple/t/reset.t#3 integrate
... //depot/maint-5.8/perl/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t#1
branch
... //depot/maint-5.8/perl/lib/Test/Simple/t/todo.t#6 integrate
... //depot/maint-5.8/perl/lib/Test/Simple/t/use_ok.t#3 integrate
... //depot/maint-5.8/perl/lib/Test/Simple/t/utf8.t#1 branch
... //depot/maint-5.8/perl/lib/base/t/lib/Dummy.pm#1 branch
... //depot/maint-5.8/perl/lib/base/t/version.t#2 integrate
... //depot/maint-5.8/perl/t/lib/Dummy.pm#2 delete
... //depot/maint-5.8/perl/t/lib/NoExporter.pm#2 delete
... //depot/maint-5.8/perl/t/lib/Test/Simple/sample_tests/death.plx#2 integrate
...
//depot/maint-5.8/perl/t/lib/Test/Simple/sample_tests/death_with_handler.plx#1
branch
...
//depot/maint-5.8/perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx#2
integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#442 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#441~34326~ 2008-09-09 08:19:03.000000000 -0700
+++ perl/MANIFEST 2008-09-16 09:02:43.000000000 -0700
@@ -1327,6 +1327,7 @@
lib/base/t/fields-base.t See if fields work
lib/base/t/fields.t See if fields work
lib/base/t/isa.t See if base's behaviour doesn't change
+lib/base/t/lib/Dummy.pm Test module for base.pm
lib/base/t/sigdie.t See if base works with SIGDIE
lib/base/t/version.t See if base works with versions
lib/base/t/warnings.t See if base works with warnings
@@ -2096,6 +2097,7 @@
lib/Test/Simple/t/00test_harness_check.t Test::Simple test
lib/Test/Simple/t/bad_plan.t Test::Builder plan() test
lib/Test/Simple/t/bail_out.t Test::Builder BAIL_OUT test
+lib/Test/Simple/t/BEGIN_require_ok.t Test::More require_ok() testing
lib/Test/Simple/t/BEGIN_use_ok.t Test::More use_ok() testing
lib/Test/Simple/t/buffer.t Test::Builder buffering test
lib/Test/Simple/t/Builder.t Test::Builder tests
@@ -2106,6 +2108,7 @@
lib/Test/Simple/t/curr_test.t Test::Builder->curr_test tests
lib/Test/Simple/t/details.t Test::Builder tests
lib/Test/Simple/t/diag.t Test::More diag() test
+lib/Test/Simple/t/dont_overwrite_die_handler.t Test::More tests
lib/Test/Simple/t/eq_set.t Test::Simple test
lib/Test/Simple/t/exit.t Test::Simple test, exit codes
lib/Test/Simple/t/extra_one.t Test::Simple test
@@ -2125,7 +2128,8 @@
lib/Test/Simple/t/is_deeply_with_threads.t Test::More test
lib/Test/Simple/t/is_fh.t Test::Builder test, _is_fh()
lib/Test/Simple/t/lib/Dummy.pm Test::More test module
-lib/Test/Simple/t/lib/MyOverload.pm Test::More test module
+lib/Test/Simple/t/lib/MyOverload.pm Test::More test module
+lib/Test/Simple/t/lib/NoExporter.pm Test::Simple test module
lib/Test/Simple/t/maybe_regex.t Test::Builder->maybe_regex() tests
lib/Test/Simple/t/missing.t Test::Simple test, missing tests
lib/Test/Simple/t/More.t Test::More test, basic stuff
@@ -2149,6 +2153,7 @@
lib/Test/Simple/t/simple.t Test::Simple test, basic stuff
lib/Test/Simple/t/skipall.t Test::More test, skip all tests
lib/Test/Simple/t/skip.t Test::More test, SKIP tests
+lib/Test/Simple/t/tbm_doesnt_set_exported_to.t Test::Builder::Module test
lib/Test/Simple/t/tbt_01basic.t Test::Builder::Tester test
lib/Test/Simple/t/tbt_02fhrestore.t Test::Builder::Tester test
lib/Test/Simple/t/tbt_03die.t Test::Builder::Tester test
@@ -2163,6 +2168,7 @@
lib/Test/Simple/t/undef.t Test::More test, undefs don't cause warnings
lib/Test/Simple/t/useing.t Test::More test, compile test
lib/Test/Simple/t/use_ok.t Test::More test, use_ok()
+lib/Test/Simple/t/utf8.t Test::More test
lib/Test/t/05_about_verbose.t See if Test works
lib/Test/t/fail.t See if Test works
lib/Test/t/mix.t See if Test works
@@ -2868,7 +2874,6 @@
t/lib/dprof/test8_t Perl code profiler tests
t/lib/dprof/test8_v Perl code profiler tests
t/lib/dprof/V.pm Perl code profiler tests
-t/lib/Dummy.pm Module for testing base.pm
t/lib/Filter/Simple/ExportTest.pm Helper file for Filter::Simple tests
t/lib/Filter/Simple/FilterOnlyTest.pm Helper file for Filter::Simple tests
t/lib/Filter/Simple/FilterTest.pm Helper file for Filter::Simple tests
@@ -2890,7 +2895,6 @@
t/lib/Math/BigInt/Scalar.pm Pure Perl module to support Math::BigInt
t/lib/Math/BigInt/Subclass.pm Empty subclass of BigInt for test
t/lib/Math/BigRat/Test.pm Math::BigRat test helper
-t/lib/NoExporter.pm Part of Test-Simple
t/lib/proxy_constant_subs.t Test that Proxy Constant Subs behave correctly
t/lib/sample-tests/bailout Test data for Test::Harness
t/lib/sample-tests/bignum Test data for Test::Harness
@@ -2929,6 +2933,7 @@
t/lib/strict/vars Tests of "use strict 'vars'" for strict.t
t/lib/Test/Simple/Catch.pm Utility module for testing Test::Simple
t/lib/Test/Simple/sample_tests/death_in_eval.plx for exit.t
+t/lib/Test/Simple/sample_tests/death_with_handler.plx for exit.t
t/lib/Test/Simple/sample_tests/death.plx for exit.t
t/lib/Test/Simple/sample_tests/exit.plx for exit.t
t/lib/Test/Simple/sample_tests/extras.plx for exit.t
==== //depot/maint-5.8/perl/lib/Test/Builder.pm#12 (text) ====
Index: perl/lib/Test/Builder.pm
--- perl/lib/Test/Builder.pm#11~33187~ 2008-02-02 07:21:22.000000000 -0800
+++ perl/lib/Test/Builder.pm 2008-09-16 09:02:43.000000000 -0700
@@ -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.74';
-$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 @@
=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 @@
# 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 @@
$self->{No_Header} = 0;
$self->{No_Ending} = 0;
+ $self->{TODO} = undef;
+
$self->_dup_stdhandles unless $^C;
- return undef;
+ return;
}
=back
@@ -210,25 +193,6 @@
=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 @@
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 @@
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 @@
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 @@
}
}
+ local $Level = $Level + 1;
return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
got: %s
expected: %s
@@ -705,7 +697,8 @@
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 @@
$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 @@
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 @@
}
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 @@
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 @@
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 @@
return $self->{$attribute};
};
- no strict 'refs';
+ no strict 'refs'; ## no critic
*{__PACKAGE__.'::'.$method} = $code;
}
@@ -1332,10 +1341,9 @@
$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 @@
}
+my($Testout, $Testerr);
sub _dup_stdhandles {
my $self = shift;
@@ -1357,28 +1366,46 @@
# 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 @@
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 @@
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 @@
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 @@
=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 @@
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 @@
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
==== //depot/maint-5.8/perl/lib/Test/Builder/Module.pm#6 (text) ====
Index: perl/lib/Test/Builder/Module.pm
--- perl/lib/Test/Builder/Module.pm#5~33187~ 2008-02-02 07:21:22.000000000
-0800
+++ perl/lib/Test/Builder/Module.pm 2008-09-16 09:02:43.000000000 -0700
@@ -1,13 +1,13 @@
package Test::Builder::Module;
+use strict;
+
use Test::Builder;
require Exporter;
[EMAIL PROTECTED] = qw(Exporter);
+our @ISA = qw(Exporter);
-$VERSION = '0.74';
-
-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 @@
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;
==== //depot/maint-5.8/perl/lib/Test/Builder/Tester.pm#5 (text) ====
Index: perl/lib/Test/Builder/Tester.pm
--- perl/lib/Test/Builder/Tester.pm#4~33187~ 2008-02-02 07:21:22.000000000
-0800
+++ perl/lib/Test/Builder/Tester.pm 2008-09-16 09:02:43.000000000 -0700
@@ -1,8 +1,7 @@
package Test::Builder::Tester;
use strict;
-use vars qw(@EXPORT $VERSION @ISA);
-$VERSION = "1.11";
+our $VERSION = "1.13";
use Test::Builder;
use Symbol;
@@ -56,9 +55,9 @@
###
use Exporter;
[EMAIL PROTECTED] = qw(Exporter);
+our @ISA = qw(Exporter);
[EMAIL PROTECTED] = 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 @@
=cut
-sub test_out(@)
+sub test_out
{
# do we need to do any setup?
_start_testing() unless $testing;
@@ -196,7 +195,7 @@
$out->expect(@_)
}
-sub test_err(@)
+sub test_err
{
# do we need to do any setup?
_start_testing() unless $testing;
@@ -549,36 +548,36 @@
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;
}
}
==== //depot/maint-5.8/perl/lib/Test/More.pm#15 (text) ====
Index: perl/lib/Test/More.pm
--- perl/lib/Test/More.pm#14~33187~ 2008-02-02 07:21:22.000000000 -0800
+++ perl/lib/Test/More.pm 2008-09-16 09:02:43.000000000 -0700
@@ -1,7 +1,6 @@
package Test::More;
-use 5.004;
-
+use 5.006;
use strict;
@@ -16,7 +15,7 @@
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.74';
+$VERSION = '0.80';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
@@ -31,7 +30,7 @@
plan
can_ok isa_ok
diag
- BAIL_OUT
+ BAIL_OUT
);
@@ -659,30 +658,28 @@
my($pack,$filename,$line) = caller;
- # Work around a glitch in $@ and eval
- my $eval_error;
- {
- local($@,$!,$SIG{__DIE__}); # isolate eval
-
- 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;
+ 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.
+ $code = <<USE;
package $pack;
use $module $imports[0];
+1;
USE
- }
- else {
- eval <<USE;
+ }
+ else {
+ $code = <<USE;
package $pack;
-use $module [EMAIL PROTECTED];
+use $module [EMAIL PROTECTED];
+1;
USE
- }
- $eval_error = $@;
}
- my $ok = $tb->ok( !$eval_error, "use $module;" );
+ my($eval_result, $eval_error) = _eval($code, [EMAIL PROTECTED]);
+ my $ok = $tb->ok( $eval_result, "use $module;" );
+
unless( $ok ) {
chomp $eval_error;
$@ =~ s{^BEGIN failed--compilation aborted at .*$}
@@ -697,6 +694,20 @@
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);
@@ -716,20 +727,20 @@
# 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
}
@@ -1443,7 +1454,7 @@
=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
==== //depot/maint-5.8/perl/lib/Test/Simple.pm#12 (text) ====
Index: perl/lib/Test/Simple.pm
--- perl/lib/Test/Simple.pm#11~33187~ 2008-02-02 07:21:22.000000000 -0800
+++ perl/lib/Test/Simple.pm 2008-09-16 09:02:43.000000000 -0700
@@ -4,7 +4,7 @@
use strict 'vars';
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.74';
+$VERSION = '0.80';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
==== //depot/maint-5.8/perl/lib/Test/Simple/Changes#12 (text) ====
Index: perl/lib/Test/Simple/Changes
--- perl/lib/Test/Simple/Changes#11~33187~ 2008-02-02 07:21:22.000000000
-0800
+++ perl/lib/Test/Simple/Changes 2008-09-16 09:02:43.000000000 -0700
@@ -1,3 +1,72 @@
+0.80 Sun Apr 6 17:25:01 CEST 2008
+ Test fixes
+ - Completely disable the utf8 test. It was causing perl to panic on some
OS's.
+
+
+0.79_01 Wed Feb 27 03:04:54 PST 2008
+ Bug fixes
+ - Let's try the IO layer copying again, this time with the test
+ fixed for 5.10.
+
+
+0.78 Wed Feb 27 01:59:09 PST 2008
+ Bug fixes
+ * Whoops, the version of Test::Builder::Tester got moved backwards.
+
+
+0.77 Wed Feb 27 01:55:55 PST 2008
+ Bug fixes
+ - "use Test::Builder::Module" no longer sets exported_to() or does
+ any other importing.
+ - Fix the $TODO finding code so it can find $TODO without the benefit
+ of exported_to(), which is often wrong.
+ - Turn off the filehandle locale stuff for the moment, there's a
+ problem on 5.10. We'll try it again next release.
+
+ Doc improvements
+ - Improve the Test::Builder SYNOPSIS to use Test::Builder::Module
+ rather than write it's own import().
+
+
+0.76_02 Sun Feb 24 13:12:55 PST 2008
+ Bug fixes
+ * The default test output filehandles will NOT use utf8.
+ They will now copy the IO layers from STDOUT and STDERR.
+ This means if :utf8 is on then it will honor it and not
+ warn about wide characters.
+
+
+0.76_01 Sat Feb 23 20:44:32 PST 2008
+ Bug fixes
+ * Test::Builder no longer uses a __DIE__ handler. This resolves a number
+ of problems with exit codes being swallowed or other module's handlers
+ being interfered with. [rt.cpan.org 25294]
+ - Allow maybe_regex() to detect blessed regexes. [bleadperl @32880]
+ - The default test output filehandles will now use utf8.
+ [rt.cpan.org 21091]
+
+ Test fixes
+ - Remove the signature test. Adds no security and just generates
+ failures.
+
+
+0.75 Sat Feb 23 19:03:38 PST 2008
+ Incompatibilities
+ * The minimum version is now 5.6.0.
+
+ Bug fixes
+ - Turns out require_ok() had the same bug as use_ok() in a BEGIN block.
+ - ok() was not honoring exported_to() when looking for $TODO as it
+ should be.
+
+ Test fixes
+ * is_deeply_with_threads.t will not run unless AUTHOR_TESTING is set.
+ This is because it tickles intermittent threading bugs in many perls
+ and causes a lot of bug reports about which I can do nothing.
+
+ Misc
+ - Ran through perlcritic and did some cleaning.
+
0.74 Thu Nov 29 15:39:57 PST 2007
Misc
- Add abstract and author to the meta information.
==== //depot/maint-5.8/perl/lib/Test/Simple/t/BEGIN_require_ok.t#1 (text) ====
Index: perl/lib/Test/Simple/t/BEGIN_require_ok.t
--- /dev/null 2008-09-15 06:17:34.554082470 -0700
+++ perl/lib/Test/Simple/t/BEGIN_require_ok.t 2008-09-16 09:02:43.000000000
-0700
@@ -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/';
==== //depot/maint-5.8/perl/lib/Test/Simple/t/More.t#8 (text) ====
Index: perl/lib/Test/Simple/t/More.t
--- perl/lib/Test/Simple/t/More.t#7~32371~ 2007-11-17 08:19:24.000000000
-0800
+++ perl/lib/Test/Simple/t/More.t 2008-09-16 09:02:43.000000000 -0700
@@ -3,7 +3,7 @@
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
- @INC = qw(../lib lib);
+ @INC = qw(../lib ../lib/Test/Simple/t/lib);
}
}
@@ -17,7 +17,7 @@
$! = $Errno;
use_ok('Dummy');
-is( $Dummy::VERSION, '5.562', 'use_ok() loads a module' );
+is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' );
require_ok('Test::More');
==== //depot/maint-5.8/perl/lib/Test/Simple/t/dont_overwrite_die_handler.t#1
(text) ====
Index: perl/lib/Test/Simple/t/dont_overwrite_die_handler.t
--- /dev/null 2008-09-15 06:17:34.554082470 -0700
+++ perl/lib/Test/Simple/t/dont_overwrite_die_handler.t 2008-09-16
09:02:43.000000000 -0700
@@ -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';
==== //depot/maint-5.8/perl/lib/Test/Simple/t/exit.t#5 (text) ====
Index: perl/lib/Test/Simple/t/exit.t
--- perl/lib/Test/Simple/t/exit.t#4~26615~ 2006-01-03 09:44:11.000000000
-0800
+++ perl/lib/Test/Simple/t/exit.t 2008-09-16 09:02:43.000000000 -0700
@@ -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)");
}
==== //depot/maint-5.8/perl/lib/Test/Simple/t/filehandles.t#2 (text) ====
Index: perl/lib/Test/Simple/t/filehandles.t
--- perl/lib/Test/Simple/t/filehandles.t#1~17645~ 2002-07-19
12:29:57.000000000 -0700
+++ perl/lib/Test/Simple/t/filehandles.t 2008-09-16 09:02:43.000000000
-0700
@@ -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 }
==== //depot/maint-5.8/perl/lib/Test/Simple/t/is_deeply_with_threads.t#2 (text)
====
Index: perl/lib/Test/Simple/t/is_deeply_with_threads.t
--- perl/lib/Test/Simple/t/is_deeply_with_threads.t#1~32371~ 2007-11-17
08:19:24.000000000 -0800
+++ perl/lib/Test/Simple/t/is_deeply_with_threads.t 2008-09-16
09:02:43.000000000 -0700
@@ -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 {
@@ -36,7 +41,7 @@
'hello', 's', 'thisisalongname', '1', '2', '3',
'abc', 'xyz', '1234567890', 'm', 'n', 'p' );
my @list2 = @list;
- print "# kid $kid before eq_set\n";
+ print "# kid $kid before is_deeply\n";
for my $j (1..100) {
is_deeply([EMAIL PROTECTED], [EMAIL PROTECTED]);
@@ -56,3 +61,5 @@
my $rc = $t->join();
cmp_ok( $rc, '==', 42, "threads exit status is $rc" );
}
+
+pass("End of test");
==== //depot/maint-5.8/perl/lib/Test/Simple/t/lib/NoExporter.pm#1 (text) ====
Index: perl/lib/Test/Simple/t/lib/NoExporter.pm
--- /dev/null 2008-09-15 06:17:34.554082470 -0700
+++ perl/lib/Test/Simple/t/lib/NoExporter.pm 2008-09-16 09:02:43.000000000
-0700
@@ -0,0 +1,10 @@
+package NoExporter;
+
+$VERSION = 1.02;
+sub import {
+ shift;
+ die "NoExporter exports nothing. You asked for: @_" if @_;
+}
+
+1;
+
==== //depot/maint-5.8/perl/lib/Test/Simple/t/maybe_regex.t#3 (text) ====
Index: perl/lib/Test/Simple/t/maybe_regex.t
--- perl/lib/Test/Simple/t/maybe_regex.t#2~23692~ 2004-12-29
04:03:15.000000000 -0800
+++ perl/lib/Test/Simple/t/maybe_regex.t 2008-09-16 09:02:43.000000000
-0700
@@ -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' );
}
{
==== //depot/maint-5.8/perl/lib/Test/Simple/t/reset.t#3 (text) ====
Index: perl/lib/Test/Simple/t/reset.t
--- perl/lib/Test/Simple/t/reset.t#2~23929~ 2005-02-05 04:57:43.000000000
-0800
+++ perl/lib/Test/Simple/t/reset.t 2008-09-16 09:02:43.000000000 -0700
@@ -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' );
==== //depot/maint-5.8/perl/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t#1
(text) ====
Index: perl/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t
--- /dev/null 2008-09-15 06:17:34.554082470 -0700
+++ perl/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t 2008-09-16
09:02:43.000000000 -0700
@@ -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
==== //depot/maint-5.8/perl/lib/Test/Simple/t/todo.t#6 (text) ====
Index: perl/lib/Test/Simple/t/todo.t
--- perl/lib/Test/Simple/t/todo.t#5~26615~ 2006-01-03 09:44:11.000000000
-0800
+++ perl/lib/Test/Simple/t/todo.t 2008-09-16 09:02:43.000000000 -0700
@@ -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");
+}
==== //depot/maint-5.8/perl/lib/Test/Simple/t/use_ok.t#3 (text) ====
Index: perl/lib/Test/Simple/t/use_ok.t
--- perl/lib/Test/Simple/t/use_ok.t#2~23596~ 2004-12-01 12:40:59.000000000
-0800
+++ perl/lib/Test/Simple/t/use_ok.t 2008-09-16 09:02:43.000000000 -0700
@@ -3,7 +3,7 @@
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
- @INC = ('../lib', 'lib');
+ @INC = qw(../lib ../lib/Test/Simple/t/lib);
}
else {
unshift @INC, 't/lib';
==== //depot/maint-5.8/perl/lib/Test/Simple/t/utf8.t#1 (text) ====
Index: perl/lib/Test/Simple/t/utf8.t
--- /dev/null 2008-09-15 06:17:34.554082470 -0700
+++ perl/lib/Test/Simple/t/utf8.t 2008-09-16 09:02:43.000000000 -0700
@@ -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( [EMAIL PROTECTED], [] );
+}
==== //depot/maint-5.8/perl/lib/base/t/lib/Dummy.pm#1 (text) ====
Index: perl/lib/base/t/lib/Dummy.pm
--- /dev/null 2008-09-15 06:17:34.554082470 -0700
+++ perl/lib/base/t/lib/Dummy.pm 2008-09-16 09:02:43.000000000 -0700
@@ -0,0 +1,4 @@
+package Dummy;
+
+# Attempt to emulate a bug with finding the version in Exporter.
+$VERSION = '5.562';
==== //depot/maint-5.8/perl/lib/base/t/version.t#2 (text) ====
Index: perl/lib/base/t/version.t
--- perl/lib/base/t/version.t#1~32469~ 2007-11-23 12:37:18.000000000 -0800
+++ perl/lib/base/t/version.t 2008-09-16 09:02:43.000000000 -0700
@@ -3,7 +3,7 @@
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't' if -d 't';
- @INC = qw(../lib ../t/lib);
+ @INC = qw(../lib ../lib/base/t/lib);
}
}
==== //depot/maint-5.8/perl/t/lib/Test/Simple/sample_tests/death.plx#2 (text)
====
Index: perl/t/lib/Test/Simple/sample_tests/death.plx
--- perl/t/lib/Test/Simple/sample_tests/death.plx#1~17645~ 2002-07-19
12:29:57.000000000 -0700
+++ perl/t/lib/Test/Simple/sample_tests/death.plx 2008-09-16
09:02:43.000000000 -0700
@@ -4,10 +4,12 @@
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";
====
//depot/maint-5.8/perl/t/lib/Test/Simple/sample_tests/death_with_handler.plx#1
(text) ====
Index: perl/t/lib/Test/Simple/sample_tests/death_with_handler.plx
--- /dev/null 2008-09-15 06:17:34.554082470 -0700
+++ perl/t/lib/Test/Simple/sample_tests/death_with_handler.plx 2008-09-16
09:02:43.000000000 -0700
@@ -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";
====
//depot/maint-5.8/perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx#2
(text) ====
Index: perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx
--- perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx#1~17645~
2002-07-19 12:29:57.000000000 -0700
+++ perl/t/lib/Test/Simple/sample_tests/last_minute_death.plx 2008-09-16
09:02:43.000000000 -0700
@@ -5,7 +5,9 @@
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);
-die "Almost there...";
+die "This is a test";
End of Patch.
