From 02635cdce075ab2b140dfc8bc18438e7ba82336f Mon Sep 17 00:00:00 2001 From: Marcela Mašláňová Date: Mar 20 2008 08:45:25 +0000 Subject: - 434865 upgrade Test::Simple - turn off test on loading Dummy in More.t, can't find module (path problem?) - 238581: careless use of gethostbyname() in Socket.xs --- diff --git a/perl-5.8.8-TestSimple0.78.patch b/perl-5.8.8-TestSimple0.78.patch new file mode 100644 index 0000000..a0527f5 --- /dev/null +++ b/perl-5.8.8-TestSimple0.78.patch @@ -0,0 +1,3988 @@ +diff -up perl-5.8.8/lib/Test/More.pm.crr perl-5.8.8/lib/Test/More.pm +--- perl-5.8.8/lib/Test/More.pm.crr 2005-10-08 08:56:17.000000000 +0200 ++++ perl-5.8.8/lib/Test/More.pm 2008-02-27 11:01:46.000000000 +0100 +@@ -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.62'; ++$VERSION = '0.78'; + $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 + ); + + +@@ -41,7 +40,7 @@ Test::More - yet another framework for w + + =head1 SYNOPSIS + +- use Test::More tests => $Num_Tests; ++ use Test::More tests => 23; + # or + use Test::More qw(no_plan); + # or +@@ -51,20 +50,20 @@ Test::More - yet another framework for w + require_ok( 'Some::Module' ); + + # Various ways to say "ok" +- ok($this eq $that, $test_name); ++ ok($got eq $expected, $test_name); + +- is ($this, $that, $test_name); +- isnt($this, $that, $test_name); ++ is ($got, $expected, $test_name); ++ isnt($got, $expected, $test_name); + + # Rather than print STDERR "# here's what went wrong\n" + diag("here's what went wrong"); + +- like ($this, qr/that/, $test_name); +- unlike($this, qr/that/, $test_name); ++ like ($got, qr/expected/, $test_name); ++ unlike($got, qr/expected/, $test_name); + +- cmp_ok($this, '==', $that, $test_name); ++ cmp_ok($got, '==', $expected, $test_name); + +- is_deeply($complex_structure1, $complex_structure2, $test_name); ++ is_deeply($got_complex_structure, $expected_complex_structure, $test_name); + + SKIP: { + skip $why, $how_many unless $have_some_feature; +@@ -113,7 +112,7 @@ failure. + + The preferred way to do this is to declare a plan when you C. + +- use Test::More tests => $Num_Tests; ++ use Test::More tests => 23; + + There are rare cases when you will not know beforehand how many tests + your script is going to run. In this case, you can declare that you +@@ -226,9 +225,9 @@ respectively. + + =item B + +- ok($this eq $that, $test_name); ++ ok($got eq $expected, $test_name); + +-This simply evaluates any expression (C<$this eq $that> is just a ++This simply evaluates any expression (C<$got eq $expected> is just a + simple example) and uses that to determine if the test succeeded or + failed. A true expression passes, a false one fails. Very simple. + +@@ -252,7 +251,7 @@ Should an ok() fail, it will produce som + # Failed test 'sufficient mucus' + # in foo.t at line 42. + +-This is actually Test::Simple's ok() routine. ++This is the same as Test::Simple's ok() routine. + + =cut + +@@ -267,8 +266,8 @@ sub ok ($;$) { + + =item B + +- is ( $this, $that, $test_name ); +- isnt( $this, $that, $test_name ); ++ is ( $got, $expected, $test_name ); ++ isnt( $got, $expected, $test_name ); + + Similar to ok(), is() and isnt() compare their two arguments + with C and C respectively and use the result of that to +@@ -340,17 +339,17 @@ sub isnt ($$;$) { + + =item B + +- like( $this, qr/that/, $test_name ); ++ like( $got, qr/expected/, $test_name ); + +-Similar to ok(), like() matches $this against the regex C. ++Similar to ok(), like() matches $got against the regex C. + + So this: + +- like($this, qr/that/, 'this is like that'); ++ like($got, qr/expected/, 'this is like that'); + + is similar to: + +- ok( $this =~ /that/, 'this is like that'); ++ ok( $got =~ /expected/, 'this is like that'); + + (Mnemonic "This is like that".) + +@@ -359,9 +358,9 @@ regex reference (i.e. C) or (for b + perls) as a string that looks like a regex (alternative delimiters are + currently not supported): + +- like( $this, '/that/', 'this is like that' ); ++ like( $got, '/expected/', 'this is like that' ); + +-Regex options may be placed on the end (C<'/that/i'>). ++Regex options may be placed on the end (C<'/expected/i'>). + + Its advantages over ok() are similar to that of is() and isnt(). Better + diagnostics on failure. +@@ -377,9 +376,9 @@ sub like ($$;$) { + + =item B + +- unlike( $this, qr/that/, $test_name ); ++ unlike( $got, qr/expected/, $test_name ); + +-Works exactly as like(), only it checks if $this B match the ++Works exactly as like(), only it checks if $got B match the + given pattern. + + =cut +@@ -393,23 +392,23 @@ sub unlike ($$;$) { + + =item B + +- cmp_ok( $this, $op, $that, $test_name ); ++ cmp_ok( $got, $op, $expected, $test_name ); + + Halfway between ok() and is() lies cmp_ok(). This allows you to + compare two arguments using any binary perl operator. + +- # ok( $this eq $that ); +- cmp_ok( $this, 'eq', $that, 'this eq that' ); ++ # ok( $got eq $expected ); ++ cmp_ok( $got, 'eq', $expected, 'this eq that' ); + +- # ok( $this == $that ); +- cmp_ok( $this, '==', $that, 'this == that' ); ++ # ok( $got == $expected ); ++ cmp_ok( $got, '==', $expected, 'this == that' ); + +- # ok( $this && $that ); +- cmp_ok( $this, '&&', $that, 'this && that' ); ++ # ok( $got && $expected ); ++ cmp_ok( $got, '&&', $expected, 'this && that' ); + ...etc... + +-Its advantage over ok() is when the test fails you'll know what $this +-and $that were: ++Its advantage over ok() is when the test fails you'll know what $got ++and $expected were: + + not ok 1 + # Failed test in foo.t at line 12. +@@ -465,6 +464,12 @@ sub can_ok ($@) { + my $class = ref $proto || $proto; + my $tb = Test::More->builder; + ++ unless( $class ) { ++ my $ok = $tb->ok( 0, "->can(...)" ); ++ $tb->diag(' can_ok() called with empty class or reference'); ++ return $ok; ++ } ++ + unless( @methods ) { + my $ok = $tb->ok( 0, "$class->can(...)" ); + $tb->diag(' can_ok() called with no methods'); +@@ -473,15 +478,13 @@ sub can_ok ($@) { + + my @nok = (); + foreach my $method (@methods) { +- local($!, $@); # don't interfere with caller's $@ +- # eval sometimes resets $! +- eval { $proto->can($method) } || push @nok, $method; ++ $tb->_try(sub { $proto->can($method) }) or push @nok, $method; + } + + my $name; + $name = @methods == 1 ? "$class->can('$methods[0]')" + : "$class->can(...)"; +- ++ + my $ok = $tb->ok( !@nok, $name ); + + $tb->diag(map " $class->can('$_') failed\n", @nok); +@@ -533,10 +536,10 @@ sub isa_ok ($$;$) { + } + else { + # We can't use UNIVERSAL::isa because we want to honor isa() overrides +- local($@, $!); # eval sometimes resets $! +- my $rslt = eval { $object->isa($class) }; +- if( $@ ) { +- if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) { ++ my($rslt, $error) = $tb->_try(sub { $object->isa($class) }); ++ if( $error ) { ++ if( $error =~ /^Can't call method "isa" on unblessed reference/ ) { ++ # Its an unblessed reference + if( !UNIVERSAL::isa($object, $class) ) { + my $ref = ref $object; + $diag = "$obj_name isn't a '$class' it's a '$ref'"; +@@ -544,9 +547,8 @@ sub isa_ok ($$;$) { + } else { + die <isa on your object and got some weird error. +-This should never happen. Please contact the author immediately. + Here's the error. +-$@ ++$error + WHOA + } + } +@@ -656,32 +658,35 @@ sub use_ok ($;@) { + + my($pack,$filename,$line) = caller; + +- local($@,$!); # eval sometimes interferes with $! +- ++ 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); +@@ -708,19 +727,20 @@ sub require_ok ($) { + # Module names must be barewords, files not. + $module = qq['$module'] unless _is_module_name($module); + +- local($!, $@); # eval sometimes interferes with $! +- 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(< I'm not quite sure what will hap + + =item B + +- is_deeply( $this, $that, $test_name ); ++ is_deeply( $got, $expected, $test_name ); + +-Similar to is(), except that if $this and $that are references, it ++Similar to is(), except that if $got and $expected are references, it + does a deep comparison walking each data structure to see if they are + equivalent. If the two structures are different, it will display the + place where they start differing. +@@ -776,6 +796,12 @@ along these lines. + + use vars qw(@Data_Stack %Refs_Seen); + my $DNE = bless [], 'Does::Not::Exist'; ++ ++sub _dne { ++ ref $_[0] eq ref $DNE; ++} ++ ++ + sub is_deeply { + my $tb = Test::More->builder; + +@@ -792,21 +818,21 @@ WARNING + return $tb->ok(0); + } + +- my($this, $that, $name) = @_; ++ my($got, $expected, $name) = @_; + +- $tb->_unoverload_str(\$that, \$this); ++ $tb->_unoverload_str(\$expected, \$got); + + my $ok; +- if( !ref $this and !ref $that ) { # neither is a reference +- $ok = $tb->is_eq($this, $that, $name); ++ if( !ref $got and !ref $expected ) { # neither is a reference ++ $ok = $tb->is_eq($got, $expected, $name); + } +- elsif( !ref $this xor !ref $that ) { # one's a reference, one isn't ++ elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't + $ok = $tb->ok(0, $name); +- $tb->diag( _format_stack({ vals => [ $this, $that ] }) ); ++ $tb->diag( _format_stack({ vals => [ $got, $expected ] }) ); + } + else { # both references + local @Data_Stack = (); +- if( _deep_check($this, $that) ) { ++ if( _deep_check($got, $expected) ) { + $ok = $tb->ok(1, $name); + } + else { +@@ -848,8 +874,8 @@ sub _format_stack { + foreach my $idx (0..$#vals) { + my $val = $vals[$idx]; + $vals[$idx] = !defined $val ? 'undef' : +- $val eq $DNE ? "Does not exist" : +- ref $val ? "$val" : ++ _dne($val) ? "Does not exist" : ++ ref $val ? "$val" : + "'$val'"; + } + +@@ -995,6 +1021,11 @@ sub skip { + $how_many = 1; + } + ++ if( defined $how_many and $how_many =~ /\D/ ) { ++ _carp "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?"; ++ $how_many = 1; ++ } ++ + for( 1..$how_many ) { + $tb->skip($why); + } +@@ -1107,7 +1138,7 @@ but want to put tests in your testing sc + + BAIL_OUT($reason); + +-Incidates to the harness that things are going so badly all testing ++Indicates to the harness that things are going so badly all testing + should terminate. This includes the running any additional test scripts. + + This is typically used when testing cannot continue such as a critical +@@ -1138,11 +1169,11 @@ arbitrary data structures. + + These functions are usually used inside an ok(). + +- ok( eq_array(\@this, \@that) ); ++ ok( eq_array(\@got, \@expected) ); + + C can do that better and with diagnostics. + +- is_deeply( \@this, \@that ); ++ is_deeply( \@got, \@expected ); + + They may be deprecated in future versions. + +@@ -1150,7 +1181,7 @@ They may be deprecated in future version + + =item B + +- my $is_eq = eq_array(\@this, \@that); ++ my $is_eq = eq_array(\@got, \@expected); + + Checks if two arrays are equivalent. This is a deep check, so + multi-level structures are handled correctly. +@@ -1213,7 +1244,7 @@ sub _deep_check { + if( defined $e1 xor defined $e2 ) { + $ok = 0; + } +- elsif ( $e1 == $DNE xor $e2 == $DNE ) { ++ elsif ( _dne($e1) xor _dne($e2) ) { + $ok = 0; + } + elsif ( $same_ref and ($e1 eq $e2) ) { +@@ -1281,7 +1312,7 @@ WHOA + + =item B + +- my $is_eq = eq_hash(\%this, \%that); ++ my $is_eq = eq_hash(\%got, \%expected); + + Determines if the two hashes contain the same keys and values. This + is a deep check. +@@ -1321,17 +1352,17 @@ sub _eq_hash { + + =item B + +- my $is_eq = eq_set(\@this, \@that); ++ my $is_eq = eq_set(\@got, \@expected); + + Similar to eq_array(), except the order of the elements is B + important. This is a deep check, but the irrelevancy of order only + applies to the top level. + +- ok( eq_set(\@this, \@that) ); ++ ok( eq_set(\@got, \@expected) ); + + Is better written: + +- is_deeply( [sort @this], [sort @that] ); ++ is_deeply( [sort @got], [sort @expected] ); + + B By historical accident, this is not a true set comparison. + While the order of elements does not matter, duplicate elements do. +@@ -1423,7 +1454,7 @@ B 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 +@@ -1454,6 +1485,8 @@ This may cause problems: + use Test::More + use threads; + ++5.8.1 and above are supported. Anything below that has too many bugs. ++ + + =item Test::Harness upgrade + +@@ -1524,9 +1557,9 @@ See F to report and + + =head1 COPYRIGHT + +-Copyright 2001, 2002, 2004 by Michael G Schwern Eschwern@pobox.comE. ++Copyright 2001-2002, 2004-2006 by Michael G Schwern Eschwern@pobox.comE. + +-This program is free software; you can redistribute it and/or ++This program is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + See F +diff -up perl-5.8.8/lib/Test/Tutorial.pod.crr perl-5.8.8/lib/Test/Tutorial.pod +diff -up perl-5.8.8/lib/Test/Builder.pm.crr perl-5.8.8/lib/Test/Builder.pm +--- perl-5.8.8/lib/Test/Builder.pm.crr 2005-10-08 10:02:05.000000000 +0200 ++++ perl-5.8.8/lib/Test/Builder.pm 2008-02-27 11:01:46.000000000 +0100 +@@ -1,21 +1,17 @@ + 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.32'; +-$VERSION = eval $VERSION; # make the alpha version come out as a number ++ ++our $VERSION = '0.78'; ++$VERSION = eval { $VERSION }; # make the alpha version come out as a number + + # Make Test::Builder thread-safe for ithreads. + BEGIN { + use Config; +- # Load threads::shared when threads are turned on +- if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) { ++ # Load threads::shared when threads are turned on. ++ # 5.8.0's threads are so busted we no longer support them. ++ if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'}) { + require threads::shared; + + # Hack around YET ANOTHER threads::shared bug. It would +@@ -35,7 +31,7 @@ BEGIN { + $$data = ${$_[0]}; + } + else { +- die "Unknown type: ".$type; ++ die("Unknown type: ".$type); + } + + $_[0] = &threads::shared::share($_[0]); +@@ -50,14 +46,14 @@ BEGIN { + ${$_[0]} = $$data; + } + else { +- die "Unknown type: ".$type; ++ die("Unknown type: ".$type); + } + + return $_[0]; + }; + } +- # 5.8.0's threads::shared is busted when threads are off. +- # We emulate it here. ++ # 5.8.0's threads::shared is busted when threads are off ++ # and earlier Perls just don't have that module at all. + else { + *share = sub { return $_[0] }; + *lock = sub { 0 }; +@@ -72,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); + } + + +@@ -176,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} = $$; +@@ -195,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 +@@ -209,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'); +@@ -246,9 +211,10 @@ sub plan { + + return unless $cmd; + ++ local $Level = $Level + 1; ++ + if( $self->{Have_Plan} ) { +- die sprintf "You tried to plan twice! Second plan at %s line %d\n", +- ($self->caller)[1,2]; ++ $self->croak("You tried to plan twice"); + } + + if( $cmd eq 'no_plan' ) { +@@ -259,20 +225,19 @@ sub plan { + } + elsif( $cmd eq 'tests' ) { + if( $arg ) { ++ local $Level = $Level + 1; + return $self->expected_tests($arg); + } + elsif( !defined $arg ) { +- die "Got an undefined number of tests. Looks like you tried to ". +- "say how many tests you plan to run but made a mistake.\n"; ++ $self->croak("Got an undefined number of tests"); + } + elsif( !$arg ) { +- die "You said to run 0 tests! You've got to run something.\n"; ++ $self->croak("You said to run 0 tests"); + } + } + else { +- require Carp; + my @args = grep { defined } ($cmd, $arg); +- Carp::croak("plan() doesn't understand @args"); ++ $self->croak("plan() doesn't understand @args"); + } + + return 1; +@@ -293,7 +258,7 @@ sub expected_tests { + my($max) = @_; + + if( @_ ) { +- die "Number of tests must be a postive integer. You gave it '$max'.\n" ++ $self->croak("Number of tests must be a positive integer. You gave it '$max'") + unless $max =~ /^\+?\d+$/ and $max > 0; + + $self->{Expected_Tests} = $max; +@@ -359,12 +324,36 @@ 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 + +-These actually run the tests, analogous to the functions in +-Test::More. ++These actually run the tests, analogous to the functions in Test::More. ++ ++They all return true if the test passed, false if the test failed. + + $name is always optional. + +@@ -386,10 +375,7 @@ sub ok { + # store, so we turn it into a boolean. + $test = $test ? 1 : 0; + +- unless( $self->{Have_Plan} ) { +- require Carp; +- Carp::croak("You tried to run a test without a plan! Gotta have a plan."); +- } ++ $self->_plan_check; + + lock $self->{Curr_Test}; + $self->{Curr_Test}++; +@@ -402,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; +@@ -449,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[ in $file at line $line.\n]); +- } +- else { +- $self->diag(qq[ $msg test in $file at 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; +@@ -466,26 +456,22 @@ sub _unoverload { + my $self = shift; + my $type = shift; + +- local($@,$!); +- +- eval { require overload } || return; ++ $self->_try(sub { require overload } ) || return; + + foreach my $thing (@_) { +- eval { +- if( _is_object($$thing) ) { +- if( my $string_meth = overload::Method($$thing, $type) ) { +- $$thing = $$thing->$string_meth(); +- } ++ if( $self->_is_object($$thing) ) { ++ if( my $string_meth = overload::Method($$thing, $type) ) { ++ $$thing = $$thing->$string_meth(); + } +- }; ++ } + } + } + + + sub _is_object { +- my $thing = shift; ++ my($self, $thing) = @_; + +- return eval { ref $thing && $thing->isa('UNIVERSAL') } ? 1 : 0; ++ return $self->_try(sub { ref $thing && $thing->isa('UNIVERSAL') }) ? 1 : 0; + } + + +@@ -589,6 +575,7 @@ sub _is_diag { + } + } + ++ local $Level = $Level + 1; + return $self->diag(sprintf < + +- $Test->is_num($got, $dont_expect, $name); ++ $Test->isnt_num($got, $dont_expect, $name); + + Like Test::More's isnt(). Checks if $got ne $dont_expect. This is + the numeric version. +@@ -678,97 +665,6 @@ sub unlike { + $self->_regex_ok($this, $regex, '!~', $name); + } + +-=item B +- +- $Test->maybe_regex(qr/$regex/); +- $Test->maybe_regex('/$regex/'); +- +-Convenience method for building testing functions that take regular +-expressions as arguments, but need to work before perl 5.005. +- +-Takes a quoted regular expression produced by qr//, or a string +-representing a regular expression. +- +-Returns a Perl value which may be used instead of the corresponding +-regular expression, or undef if it's argument is not recognised. +- +-For example, a version of like(), sans the useful diagnostic messages, +-could be written as: +- +- sub laconic_like { +- my ($self, $this, $regex, $name) = @_; +- my $usable_regex = $self->maybe_regex($regex); +- die "expecting regex, found '$regex'\n" +- unless $usable_regex; +- $self->ok($this =~ m/$usable_regex/, $name); +- } +- +-=cut +- +- +-sub maybe_regex { +- my ($self, $regex) = @_; +- my $usable_regex = undef; +- +- return $usable_regex unless defined $regex; +- +- my($re, $opts); +- +- # Check for qr/foo/ +- if( ref $regex eq 'Regexp' ) { +- $usable_regex = $regex; +- } +- # Check for '/foo/' or 'm,foo,' +- elsif( ($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or +- (undef, $re, $opts) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx +- ) +- { +- $usable_regex = length $opts ? "(?$opts)$re" : $re; +- } +- +- return $usable_regex; +-}; +- +-sub _regex_ok { +- my($self, $this, $regex, $cmp, $name) = @_; +- +- my $ok = 0; +- my $usable_regex = $self->maybe_regex($regex); +- unless (defined $usable_regex) { +- $ok = $self->ok( 0, $name ); +- $self->diag(" '$regex' doesn't look much like a regex to me."); +- return $ok; +- } +- +- { +- my $test; +- my $code = $self->_caller_context; +- +- local($@, $!); +- +- # 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}; +- +- $test = !$test if $cmp eq '!~'; +- +- local $Level = $Level + 1; +- $ok = $self->ok( $test, $name ); +- } +- +- unless( $ok ) { +- $this = defined $this ? "'$this'" : 'undef'; +- my $match = $cmp eq '=~' ? "doesn't match" : "matches"; +- $self->diag(sprintf < + +@@ -797,12 +693,12 @@ sub cmp_ok { + + my $test; + { +- local($@,$!); # don't interfere with $@ +- # eval() sometimes resets $! ++ local($@,$!,$SIG{__DIE__}); # isolate eval + + 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;"; +@@ -827,6 +723,8 @@ sub _cmp_diag { + + $got = defined $got ? "'$got'" : 'undef'; + $expect = defined $expect ? "'$expect'" : 'undef'; ++ ++ local $Level = $Level + 1; + return $self->diag(sprintf < + +@@ -889,10 +795,7 @@ sub skip { + $why ||= ''; + $self->_unoverload_str(\$why); + +- unless( $self->{Have_Plan} ) { +- require Carp; +- Carp::croak("You tried to run tests without a plan! Gotta have a plan."); +- } ++ $self->_plan_check; + + lock($self->{Curr_Test}); + $self->{Curr_Test}++; +@@ -933,10 +836,7 @@ sub todo_skip { + my($self, $why) = @_; + $why ||= ''; + +- unless( $self->{Have_Plan} ) { +- require Carp; +- Carp::croak("You tried to run tests without a plan! Gotta have a plan."); +- } ++ $self->_plan_check; + + lock($self->{Curr_Test}); + $self->{Curr_Test}++; +@@ -977,8 +877,179 @@ test. + =back + + ++=head2 Test building utility methods ++ ++These methods are useful when writing your own test methods. ++ ++=over 4 ++ ++=item B ++ ++ $Test->maybe_regex(qr/$regex/); ++ $Test->maybe_regex('/$regex/'); ++ ++Convenience method for building testing functions that take regular ++expressions as arguments, but need to work before perl 5.005. ++ ++Takes a quoted regular expression produced by qr//, or a string ++representing a regular expression. ++ ++Returns a Perl value which may be used instead of the corresponding ++regular expression, or undef if it's argument is not recognised. ++ ++For example, a version of like(), sans the useful diagnostic messages, ++could be written as: ++ ++ sub laconic_like { ++ my ($self, $this, $regex, $name) = @_; ++ my $usable_regex = $self->maybe_regex($regex); ++ die "expecting regex, found '$regex'\n" ++ unless $usable_regex; ++ $self->ok($this =~ m/$usable_regex/, $name); ++ } ++ ++=cut ++ ++ ++sub maybe_regex { ++ my ($self, $regex) = @_; ++ my $usable_regex = undef; ++ ++ return $usable_regex unless defined $regex; ++ ++ my($re, $opts); ++ ++ # Check for qr/foo/ ++ if( _is_qr($regex) ) { ++ $usable_regex = $regex; ++ } ++ # Check for '/foo/' or 'm,foo,' ++ elsif( ($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or ++ (undef, $re, $opts) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx ++ ) ++ { ++ $usable_regex = length $opts ? "(?$opts)$re" : $re; ++ } ++ ++ 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) = @_; ++ ++ my $ok = 0; ++ my $usable_regex = $self->maybe_regex($regex); ++ unless (defined $usable_regex) { ++ $ok = $self->ok( 0, $name ); ++ $self->diag(" '$regex' doesn't look much like a regex to me."); ++ return $ok; ++ } ++ ++ { ++ my $test; ++ my $code = $self->_caller_context; ++ ++ local($@, $!, $SIG{__DIE__}); # isolate eval ++ ++ # 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}; ++ ++ $test = !$test if $cmp eq '!~'; ++ ++ local $Level = $Level + 1; ++ $ok = $self->ok( $test, $name ); ++ } ++ ++ unless( $ok ) { ++ $this = defined $this ? "'$this'" : 'undef'; ++ my $match = $cmp eq '=~' ? "doesn't match" : "matches"; ++ ++ local $Level = $Level + 1; ++ $self->diag(sprintf < ++ ++ my $return_from_code = $Test->try(sub { code }); ++ my($return_from_code, $error) = $Test->try(sub { code }); ++ ++Works like eval BLOCK except it ensures it has no effect on the rest of the test (ie. $@ is not set) nor is effected by outside interference (ie. $SIG{__DIE__}) and works around some quirks in older Perls. ++ ++$error is what would normally be in $@. ++ ++It is suggested you use this in place of eval BLOCK. ++ ++=cut ++ ++sub _try { ++ my($self, $code) = @_; ++ ++ local $!; # eval can mess up $! ++ local $@; # don't set $@ in the test ++ local $SIG{__DIE__}; # don't trip an outside DIE handler. ++ my $return = eval { $code->() }; ++ ++ return wantarray ? ($return, $@) : $return; ++} ++ ++=end private ++ ++ ++=item B ++ ++ my $is_fh = $Test->is_fh($thing); ++ ++Determines if the given $thing can be used as a filehandle. ++ ++=cut ++ ++sub is_fh { ++ my $self = shift; ++ my $maybe_fh = shift; ++ return 0 unless defined $maybe_fh; ++ ++ return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref ++ return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob ++ ++ return eval { $maybe_fh->isa("IO::Handle") } || ++ # 5.5.4's tied() and can() doesn't like getting undef ++ eval { (tied($maybe_fh) || '')->can('TIEHANDLE') }; ++} ++ ++ ++=back ++ ++ + =head2 Test style + ++ + =over 4 + + =item B +@@ -990,14 +1061,18 @@ test failed. + + Defaults to 1. + +-Setting $Test::Builder::Level overrides. This is typically useful ++Setting L<$Test::Builder::Level> overrides. This is typically useful + localized: + +- { +- local $Test::Builder::Level = 2; +- $Test->ok($test); ++ sub my_ok { ++ my $test = shift; ++ ++ local $Test::Builder::Level = $Test::Builder::Level + 1; ++ $TB->ok($test); + } + ++To be polite to other functions wrapping your own you usually want to increment C<$Level> rather than set it to a constant. ++ + =cut + + sub level { +@@ -1029,8 +1104,6 @@ or this if false + Most useful when you can't depend on the test output order, such as + when threads or forking is involved. + +-Test::Harness will accept either, but avoid mixing the two styles. +- + Defaults to on. + + =cut +@@ -1081,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; + } + +@@ -1182,6 +1255,7 @@ sub _print { + print $fh $msg; + } + ++=begin private + + =item B<_print_diag> + +@@ -1189,6 +1263,8 @@ sub _print { + + Like _print, but prints to the current diagnostic filehandle. + ++=end private ++ + =cut + + sub _print_diag { +@@ -1232,7 +1308,7 @@ sub output { + my($self, $fh) = @_; + + if( defined $fh ) { +- $self->{Out_FH} = _new_fh($fh); ++ $self->{Out_FH} = $self->_new_fh($fh); + } + return $self->{Out_FH}; + } +@@ -1241,7 +1317,7 @@ sub failure_output { + my($self, $fh) = @_; + + if( defined $fh ) { +- $self->{Fail_FH} = _new_fh($fh); ++ $self->{Fail_FH} = $self->_new_fh($fh); + } + return $self->{Fail_FH}; + } +@@ -1250,44 +1326,30 @@ sub todo_output { + my($self, $fh) = @_; + + if( defined $fh ) { +- $self->{Todo_FH} = _new_fh($fh); ++ $self->{Todo_FH} = $self->_new_fh($fh); + } + return $self->{Todo_FH}; + } + + + sub _new_fh { ++ my $self = shift; + my($file_or_fh) = shift; + + my $fh; +- if( _is_fh($file_or_fh) ) { ++ if( $self->is_fh($file_or_fh) ) { + $fh = $file_or_fh; + } + else { +- $fh = do { local *FH }; +- open $fh, ">$file_or_fh" or +- die "Can't open test output log $file_or_fh: $!"; +- _autoflush($fh); ++ open $fh, ">", $file_or_fh or ++ $self->croak("Can't open test output log $file_or_fh: $!"); ++ _autoflush($fh); + } + + return $fh; + } + + +-sub _is_fh { +- my $maybe_fh = shift; +- return 0 unless defined $maybe_fh; +- +- return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob +- +- return UNIVERSAL::isa($maybe_fh, 'GLOB') || +- UNIVERSAL::isa($maybe_fh, 'IO::Handle') || +- +- # 5.5.4's tied() and can() doesn't like getting undef +- UNIVERSAL::can((tied($maybe_fh) || ''), 'TIEHANDLE'); +-} +- +- + sub _autoflush { + my($fh) = shift; + my $old_fh = select $fh; +@@ -1296,6 +1358,7 @@ sub _autoflush { + } + + ++my($Testout, $Testerr); + sub _dup_stdhandles { + my $self = shift; + +@@ -1303,28 +1366,89 @@ 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, $dest) = @_; ++ ++ $self->_try(sub { ++ require PerlIO; ++ my @layers = PerlIO::get_layers($src); ++ ++ binmode $dest, join " ", map ":$_", @layers if @layers; ++ }); ++} ++ ++=item carp ++ ++ $tb->carp(@message); ++ ++Warns with C<@message> but the message will appear to come from the ++point where the original test function was called (C<$tb->caller>). ++ ++=item croak ++ ++ $tb->croak(@message); ++ ++Dies with C<@message> but the message will appear to come from the ++point where the original test function was called (C<$tb->caller>). ++ ++=cut ++ ++sub _message_at_caller { ++ my $self = shift; ++ ++ local $Level = $Level + 1; ++ my($pack, $file, $line) = $self->caller; ++ return join("", @_) . " at $file line $line.\n"; ++} ++ ++sub carp { ++ my $self = shift; ++ warn $self->_message_at_caller(@_); ++} ++ ++sub croak { ++ my $self = shift; ++ die $self->_message_at_caller(@_); ++} ++ ++sub _plan_check { ++ my $self = shift; ++ ++ unless( $self->{Have_Plan} ) { ++ local $Level = $Level + 2; ++ $self->croak("You tried to run a test without a plan"); ++ } ++} ++ + =back + + +@@ -1352,8 +1476,7 @@ sub current_test { + lock($self->{Curr_Test}); + if( defined $num ) { + unless( $self->{Have_Plan} ) { +- require Carp; +- Carp::croak("Can't change the current test number without a plan!"); ++ $self->croak("Can't change the current test number without a plan!"); + } + + $self->{Curr_Test} = $num; +@@ -1462,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 +@@ -1475,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; + } +@@ -1491,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 { +@@ -1523,16 +1651,16 @@ error message. + sub _sanity_check { + my $self = shift; + +- _whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!'); +- _whoa(!$self->{Have_Plan} and $self->{Curr_Test}, ++ $self->_whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!'); ++ $self->_whoa(!$self->{Have_Plan} and $self->{Curr_Test}, + 'Somehow your tests ran without a plan!'); +- _whoa($self->{Curr_Test} != @{ $self->{Test_Results} }, ++ $self->_whoa($self->{Curr_Test} != @{ $self->{Test_Results} }, + 'Somehow you got a different number of results than tests ran!'); + } + + =item B<_whoa> + +- _whoa($check, $description); ++ $self->_whoa($check, $description); + + A sanity check, similar to assert(). If the $check is true, something + has gone horribly wrong. It will die with the given $description and +@@ -1541,9 +1669,10 @@ a note to contact the author. + =cut + + sub _whoa { +- my($check, $desc) = @_; ++ my($self, $check, $desc) = @_; + if( $check ) { +- die <croak(<<"WHOA"); + WHOA! $desc + This should never happen! Please contact the author immediately! + WHOA +@@ -1574,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. +@@ -1652,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 +@@ -1676,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 +@@ -1713,10 +1834,13 @@ If you fail more than 254 tests, it will + + =head1 THREADS + +-In perl 5.8.0 and later, Test::Builder is thread-safe. The test ++In perl 5.8.1 and later, Test::Builder is thread-safe. The test + number is shared amongst all threads. This means if one thread sets + the test number using current_test() they will all be effected. + ++While versions earlier than 5.8.1 had threads they contain too many ++bugs to support. ++ + Test::Builder is only thread-aware if threads.pm is loaded I + Test::Builder. + +diff -up perl-5.8.8/lib/Test/Simple.pm.crr perl-5.8.8/lib/Test/Simple.pm +--- perl-5.8.8/lib/Test/Simple.pm.crr 2005-10-08 08:56:17.000000000 +0200 ++++ perl-5.8.8/lib/Test/Simple.pm 2008-02-27 11:01:46.000000000 +0100 +@@ -4,7 +4,7 @@ use 5.004; + + use strict 'vars'; + use vars qw($VERSION @ISA @EXPORT); +-$VERSION = '0.62'; ++$VERSION = '0.78'; + $VERSION = eval $VERSION; # make the alpha version come out as a number + + use Test::Builder::Module; +diff -uprNB perl-5.8.8/lib/Test/Simple/t/00test_harness_check.t /home/marca/Desktop/Test-Simple-0.78/t/00test_harness_check.t +--- perl-5.8.8/lib/Test/Simple/t/00test_harness_check.t 2005-09-26 18:58:26.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/00test_harness_check.t 2006-10-14 03:46:51.000000000 +0200 +@@ -8,7 +8,7 @@ plan tests => 1; + my $TH_Version = 2.03; + + require Test::Harness; +-unless( cmp_ok( $Test::Harness::VERSION, '>', $TH_Version, "T::H version" ) ) { ++unless( cmp_ok( eval $Test::Harness::VERSION, '>=', $TH_Version, "T::H version" ) ) { + diag <create; + $Test->level(0); + + if( $] >= 5.005 ) { +- $Test->plan(tests => 2); ++ $Test->plan(tests => 3); + } + else { + $Test->plan(skip_all => +@@ -47,3 +47,5 @@ Bail out! ROCKS FALL! EVERYONE DIES! + OUT + + $Test->is_eq( $Exit_Code, 255 ); ++ ++$Test->ok( $Test->can("BAILOUT"), "Backwards compat" ); +diff -uprNB perl-5.8.8/lib/Test/Simple/t/BEGIN_require_ok.t /home/marca/Desktop/Test-Simple-0.78/t/BEGIN_require_ok.t +--- perl-5.8.8/lib/Test/Simple/t/BEGIN_require_ok.t 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/BEGIN_use_ok.t /home/marca/Desktop/Test-Simple-0.78/t/BEGIN_use_ok.t +--- perl-5.8.8/lib/Test/Simple/t/BEGIN_use_ok.t 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/carp.t /home/marca/Desktop/Test-Simple-0.78/t/carp.t +--- perl-5.8.8/lib/Test/Simple/t/carp.t 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/carp.t 2006-10-24 22:40:43.000000000 +0200 +@@ -0,0 +1,32 @@ ++#!/usr/bin/perl ++ ++BEGIN { ++ if( $ENV{PERL_CORE} ) { ++ chdir 't'; ++ @INC = '../lib'; ++ } ++} ++ ++ ++use Test::More tests => 3; ++use Test::Builder; ++ ++my $tb = Test::Builder->create; ++sub foo { $tb->croak("foo") } ++sub bar { $tb->carp("bar") } ++ ++eval { foo() }; ++is $@, sprintf "foo at %s line %s.\n", $0, __LINE__ - 1; ++ ++eval { $tb->croak("this") }; ++is $@, sprintf "this at %s line %s.\n", $0, __LINE__ - 1; ++ ++{ ++ my $warning = ''; ++ local $SIG{__WARN__} = sub { ++ $warning .= join '', @_; ++ }; ++ ++ bar(); ++ is $warning, sprintf "bar at %s line %s.\n", $0, __LINE__ - 1; ++} +diff -uprNB perl-5.8.8/lib/Test/Simple/t/cmp_ok.t /home/marca/Desktop/Test-Simple-0.78/t/cmp_ok.t +--- perl-5.8.8/lib/Test/Simple/t/cmp_ok.t 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/cmp_ok.t 2007-09-14 05:40:27.000000000 +0200 +@@ -0,0 +1,82 @@ ++#!/usr/bin/perl -w ++ ++BEGIN { ++ if( $ENV{PERL_CORE} ) { ++ chdir 't'; ++ @INC = ('../lib', 'lib'); ++ } ++ else { ++ unshift @INC, 't/lib'; ++ } ++} ++ ++use strict; ++ ++require Test::Simple::Catch; ++my($out, $err) = Test::Simple::Catch::caught(); ++local $ENV{HARNESS_ACTIVE} = 0; ++ ++require Test::Builder; ++my $TB = Test::Builder->create; ++$TB->level(0); ++ ++sub try_cmp_ok { ++ my($left, $cmp, $right) = @_; ++ ++ my %expect; ++ $expect{ok} = eval "\$left $cmp \$right"; ++ $expect{error} = $@; ++ $expect{error} =~ s/ at .*\n?//; ++ ++ local $Test::Builder::Level = $Test::Builder::Level + 1; ++ my $ok = cmp_ok($left, $cmp, $right); ++ $TB->is_num(!!$ok, !!$expect{ok}); ++ ++ my $diag = $err->read; ++ if( !$ok and $expect{error} ) { ++ $diag =~ s/^# //mg; ++ $TB->like( $diag, "/\Q$expect{error}\E/" ); ++ } ++ elsif( $ok ) { ++ $TB->is_eq( $diag, '' ); ++ } ++ else { ++ $TB->ok(1); ++ } ++} ++ ++ ++use Test::More; ++Test::More->builder->no_ending(1); ++ ++my @Tests = ( ++ [1, '==', 1], ++ [1, '==', 2], ++ ["a", "eq", "b"], ++ ["a", "eq", "a"], ++ [1, "+", 1], ++ [1, "-", 1], ++); ++ ++# These don't work yet. ++if( 0 ) { ++#if( eval { require overload } ) { ++ require MyOverload; ++ ++ my $cmp = Overloaded::Compare->new("foo", 42); ++ my $ify = Overloaded::Ify->new("bar", 23); ++ ++ push @Tests, ( ++ [$cmp, '==', 42], ++ [$cmp, 'eq', "foo"], ++ [$ify, 'eq', "bar"], ++ [$ify, "==", 23], ++ ); ++} ++ ++plan tests => scalar @Tests; ++$TB->plan(tests => @Tests * 2); ++ ++for my $test (@Tests) { ++ try_cmp_ok(@$test); ++} +diff -uprNB perl-5.8.8/lib/Test/Simple/t/diag.t /home/marca/Desktop/Test-Simple-0.78/t/diag.t +--- perl-5.8.8/lib/Test/Simple/t/diag.t 2004-12-01 22:14:31.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/diag.t 2008-02-26 22:01:45.000000000 +0100 +@@ -15,7 +15,7 @@ BEGIN { + # lots of threading bugs. + use Config; + BEGIN { +- if( $] >= 5.008 && $Config{useithreads} ) { ++ if( $] >= 5.008001 && $Config{useithreads} ) { + require threads; + 'threads'->import; + } +diff -uprNB perl-5.8.8/lib/Test/Simple/t/dont_overwrite_die_handler.t /home/marca/Desktop/Test-Simple-0.78/t/dont_overwrite_die_handler.t +--- perl-5.8.8/lib/Test/Simple/t/dont_overwrite_die_handler.t 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/exit.t /home/marca/Desktop/Test-Simple-0.78/t/exit.t +--- perl-5.8.8/lib/Test/Simple/t/exit.t 2005-09-26 18:58:26.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/exit.t 2008-02-24 04:29:39.000000000 +0100 +@@ -25,18 +25,9 @@ if( $^O eq 'MacOS' ) { + 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 @@ my %Tests = ( + '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 @@ while( my($test_name, $exit_codes) = eac + 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 -uprNB perl-5.8.8/lib/Test/Simple/t/extra.t /home/marca/Desktop/Test-Simple-0.78/t/extra.t +--- perl-5.8.8/lib/Test/Simple/t/extra.t 2005-09-26 18:58:26.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/extra.t 2006-09-04 10:23:12.000000000 +0200 +@@ -48,9 +48,9 @@ OUT + + $TB->is_eq($$err, <import(tests => $Total); + ++# This should all work in the presence of a __DIE__ handler. ++local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); }; ++ ++ + my $tb = Test::More->builder; + $tb->use_numbers(0); + +@@ -58,7 +62,7 @@ my $Filename = quotemeta $0; + ok( 0, 'failing' ); + err_ok( <can(...)' +-# in $0 at line 52. ++# at $0 line 52. + # Mooble::Hooble::Yooble->can('this') failed + # Mooble::Hooble::Yooble->can('that') failed + # Failed test 'Mooble::Hooble::Yooble->can(...)' +-# in $0 at line 53. ++# at $0 line 53. + # can_ok() called with no methods ++# Failed test '->can(...)' ++# at $0 line 54. ++# can_ok() called with empty class or reference ++# Failed test 'ARRAY->can('foo')' ++# at $0 line 55. ++# ARRAY->can('foo') failed + ERR + + #line 55 +@@ -158,16 +170,16 @@ isa_ok(undef, "Wibble", "Another Wibble" + isa_ok([], "HASH"); + err_ok( <read, "/^$more_err_re/"); +@@ -262,7 +273,7 @@ My::Test::like($err->read, "/^$more_err_ + require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'); + $more_err_re = <can(...) + not ok - Mooble::Hooble::Yooble->can(...) ++not ok - ->can(...) ++not ok - ARRAY->can('foo') + not ok - The object isa Wibble + not ok - My Wibble isa Wibble + not ok - Another Wibble isa Wibble +diff -uprNB perl-5.8.8/lib/Test/Simple/t/fail_one.t /home/marca/Desktop/Test-Simple-0.78/t/fail_one.t +--- perl-5.8.8/lib/Test/Simple/t/fail_one.t 2005-09-26 18:58:26.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/fail_one.t 2006-09-04 10:23:12.000000000 +0200 +@@ -53,7 +53,7 @@ not ok 1 + OUT + + My::Test::ok($$err eq < 1; ++use lib 'lib'; ++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 -uprNB perl-5.8.8/lib/Test/Simple/t/harness_active.t /home/marca/Desktop/Test-Simple-0.78/t/harness_active.t +--- perl-5.8.8/lib/Test/Simple/t/harness_active.t 2005-09-26 18:58:26.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/harness_active.t 2006-09-04 10:23:12.000000000 +0200 +@@ -52,13 +52,13 @@ Test::More->builder->no_ending(1); + fail( "this fails" ); + err_ok( < "needs overload.pm"; ++ } ++ else { ++ plan tests => 2; ++ } ++} ++ ++{ ++ package Foo; ++ ++ use overload ++ 'eq' => \&overload_equiv, ++ '==' => \&overload_equiv; ++ ++ sub new { ++ return bless {}, shift; ++ } ++ ++ sub overload_equiv { ++ if (ref($_[0]) ne 'Foo' || ref($_[1]) ne 'Foo') { ++ print ref($_[0]), " ", ref($_[1]), "\n"; ++ die "Invalid object passed to overload_equiv\n"; ++ } ++ ++ return 1; # change to 0 ... makes little difference ++ } ++} ++ ++my $obj1 = Foo->new(); ++my $obj2 = Foo->new(); ++ ++eval { is_deeply([$obj1, $obj2], [$obj1, $obj2]); }; ++is $@, ''; ++ +diff -uprNB perl-5.8.8/lib/Test/Simple/t/is_deeply_fail.t /home/marca/Desktop/Test-Simple-0.78/t/is_deeply_fail.t +--- perl-5.8.8/lib/Test/Simple/t/is_deeply_fail.t 2005-10-02 03:40:52.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/is_deeply_fail.t 2006-09-04 10:23:12.000000000 +0200 +@@ -64,7 +64,7 @@ ok !is_deeply('foo', 'bar', 'plain strin + is( $out, "not ok 1 - plain strings\n", 'plain strings' ); + is( $err, <{this} = '42' + # \$expected->{this} = '43' +@@ -99,7 +99,7 @@ is( $out, "not ok 4 - hashes with differ + 'hashes with different keys' ); + is( $err, <{this} = Does not exist + # \$expected->{this} = '42' +@@ -111,7 +111,7 @@ is( $out, "not ok 5 - arrays of differen + 'arrays of different length' ); + is( $err, <[9] = Does not exist + # \$expected->[9] = '10' +@@ -122,7 +122,7 @@ ok !is_deeply([undef, undef], [undef], ' + is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' ); + is( $err, <[1] = undef + # \$expected->[1] = Does not exist +@@ -133,7 +133,7 @@ ok !is_deeply({ foo => undef }, {}, ' + is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' ); + is( $err, <{foo} = undef + # \$expected->{foo} = Does not exist +@@ -144,7 +144,7 @@ ok !is_deeply(\42, \23, 'scalar refs') + is( $out, "not ok 8 - scalar refs\n", 'scalar refs' ); + is( $err, <{that}{foo} = Does not exist + # \$expected->{that}{foo} = '42' +@@ -252,7 +252,7 @@ $$err = $$out = ''; + ok !is_deeply( [\'a', 'b'], [\'a', 'c'] ); + is( $out, "not ok 20\n", 'scalar refs in an array' ); + is( $err, <[1] = 'b' + # \$expected->[1] = 'c' +@@ -264,7 +264,7 @@ my $ref = \23; + ok !is_deeply( 23, $ref ); + is( $out, "not ok 21\n", 'scalar vs ref' ); + is( $err, <[0] = $array + # \$expected->[0] = $hash +@@ -330,7 +330,7 @@ ERR + ok !is_deeply( [$foo], [$bar] ); + is( $out, "not ok 26\n", 'string overloaded refs respected in diag' ); + is( $err, <[0] = $foo + # \$expected->[0] = 'wibble' +@@ -349,7 +349,7 @@ ERR + ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs'; + is( $out, "not ok 27\n" ); + like( $err, <= 5.008001 && $Config{'useithreads'} && ++ eval { require threads; 'threads'->import; 1; }) ++ { ++ print "1..0 # Skip: no working threads\n"; ++ exit 0; ++ } ++ ++ unless ( $ENV{AUTHOR_TESTING} ) { ++ print "1..0 # Skip: many perls have broken threads. Enable with AUTHOR_TESTING.\n"; ++ exit 0; ++ } ++} ++use Test::More; ++ ++my $Num_Threads = 5; ++ ++plan tests => $Num_Threads * 100 + 6; ++ ++ ++sub do_one_thread { ++ my $kid = shift; ++ my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z', ++ 'hello', 's', 'thisisalongname', '1', '2', '3', ++ 'abc', 'xyz', '1234567890', 'm', 'n', 'p' ); ++ my @list2 = @list; ++ print "# kid $kid before is_deeply\n"; ++ ++ for my $j (1..100) { ++ is_deeply(\@list, \@list2); ++ } ++ print "# kid $kid exit\n"; ++ return 42; ++} ++ ++my @kids = (); ++for my $i (1..$Num_Threads) { ++ my $t = threads->new(\&do_one_thread, $i); ++ print "# parent $$: continue\n"; ++ push(@kids, $t); ++} ++for my $t (@kids) { ++ print "# parent $$: waiting for join\n"; ++ my $rc = $t->join(); ++ cmp_ok( $rc, '==', 42, "threads exit status is $rc" ); ++} ++ ++pass("End of test"); +diff -uprNB perl-5.8.8/lib/Test/Simple/t/is_fh.t /home/marca/Desktop/Test-Simple-0.78/t/is_fh.t +--- perl-5.8.8/lib/Test/Simple/t/is_fh.t 2005-05-05 17:06:46.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/is_fh.t 2007-09-14 04:34:50.000000000 +0200 +@@ -11,19 +11,38 @@ BEGIN { + } + + use strict; +-use Test::More tests => 8; ++use Test::More tests => 11; + use TieOut; + +-ok( !Test::Builder::_is_fh("foo"), 'string is not a filehandle' ); +-ok( !Test::Builder::_is_fh(''), 'empty string' ); +-ok( !Test::Builder::_is_fh(undef), 'undef' ); ++ok( !Test::Builder->is_fh("foo"), 'string is not a filehandle' ); ++ok( !Test::Builder->is_fh(''), 'empty string' ); ++ok( !Test::Builder->is_fh(undef), 'undef' ); + + ok( open(FILE, '>foo') ); +-END { close FILE; unlink 'foo' } ++END { close FILE; 1 while unlink 'foo' } + +-ok( Test::Builder::_is_fh(*FILE) ); +-ok( Test::Builder::_is_fh(\*FILE) ); +-ok( Test::Builder::_is_fh(*FILE{IO}) ); ++ok( Test::Builder->is_fh(*FILE) ); ++ok( Test::Builder->is_fh(\*FILE) ); ++ok( Test::Builder->is_fh(*FILE{IO}) ); + + tie *OUT, 'TieOut'; +-ok( Test::Builder::_is_fh(*OUT) ); ++ok( Test::Builder->is_fh(*OUT) ); ++ok( Test::Builder->is_fh(\*OUT) ); ++ ++SKIP: { ++ skip "*TIED_HANDLE{IO} doesn't work in this perl", 1 ++ unless defined *OUT{IO}; ++ ok( Test::Builder->is_fh(*OUT{IO}) ); ++} ++ ++ ++package Lying::isa; ++ ++sub isa { ++ my $self = shift; ++ my $parent = shift; ++ ++ return 1 if $parent eq 'IO::Handle'; ++} ++ ++::ok( Test::Builder->is_fh(bless {}, "Lying::isa")); +diff -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Dev/Null.pm /home/marca/Desktop/Test-Simple-0.78/t/lib/Dev/Null.pm +--- perl-5.8.8/lib/Test/Simple/t/lib/Dev/Null.pm 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Dummy.pm /home/marca/Desktop/Test-Simple-0.78/t/lib/Dummy.pm +--- perl-5.8.8/lib/Test/Simple/t/lib/Dummy.pm 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/lib/Dummy.pm 2008-02-24 04:03:26.000000000 +0100 +@@ -0,0 +1,5 @@ ++package Dummy; ++ ++$VERSION = '0.01'; ++ ++1; +\ No newline at end of file +diff -uprNB perl-5.8.8/lib/Test/Simple/t/lib/MyOverload.pm /home/marca/Desktop/Test-Simple-0.78/t/lib/MyOverload.pm +--- perl-5.8.8/lib/Test/Simple/t/lib/MyOverload.pm 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/lib/MyOverload.pm 2008-02-24 04:03:15.000000000 +0100 +@@ -0,0 +1,29 @@ ++package Overloaded; ++ ++sub new { ++ my $class = shift; ++ bless { string => shift, num => shift }, $class; ++} ++ ++ ++package Overloaded::Compare; ++use vars qw(@ISA); ++@ISA = qw(Overloaded); ++ ++# Sometimes objects have only comparison ops overloaded and nothing else. ++# For example, DateTime objects. ++use overload ++ q{eq} => sub { $_[0]->{string} eq $_[1] }, ++ q{==} => sub { $_[0]->{num} == $_[1] }; ++ ++ ++ ++package Overloaded::Ify; ++use vars qw(@ISA); ++@ISA = qw(Overloaded); ++ ++use overload ++ q{""} => sub { $_[0]->{string} }, ++ q{0+} => sub { $_[0]->{num} }; ++ ++1; +\ No newline at end of file +diff -uprNB perl-5.8.8/lib/Test/Simple/t/lib/NoExporter.pm /home/marca/Desktop/Test-Simple-0.78/t/lib/NoExporter.pm +--- perl-5.8.8/lib/Test/Simple/t/lib/NoExporter.pm 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/Catch.pm /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/Catch.pm +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/Catch.pm 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death_in_eval.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/death_in_eval.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death_in_eval.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/death.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death_with_handler.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/death_with_handler.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/death_with_handler.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/exit.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/exit.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/exit.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/extras.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/extras.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/extras.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/five_fail.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/five_fail.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/five_fail.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/last_minute_death.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/last_minute_death.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/last_minute_death.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/one_fail.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/one_fail.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/one_fail.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/pre_plan_death.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/pre_plan_death.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/pre_plan_death.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/require.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/require.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/require.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/require.plx 2006-08-31 07:24:17.000000000 +0200 +@@ -0,0 +1 @@ ++require Test::Simple; +diff -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/success.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/success.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/success.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/too_few_fail.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/too_few_fail.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/too_few_fail.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/too_few.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/too_few.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/too_few.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/two_fail.plx /home/marca/Desktop/Test-Simple-0.78/t/lib/Test/Simple/sample_tests/two_fail.plx +--- perl-5.8.8/lib/Test/Simple/t/lib/Test/Simple/sample_tests/two_fail.plx 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/lib/TieOut.pm /home/marca/Desktop/Test-Simple-0.78/t/lib/TieOut.pm +--- perl-5.8.8/lib/Test/Simple/t/lib/TieOut.pm 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/maybe_regex.t /home/marca/Desktop/Test-Simple-0.78/t/maybe_regex.t +--- perl-5.8.8/lib/Test/Simple/t/maybe_regex.t 2004-12-29 13:16:16.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/maybe_regex.t 2008-02-24 05:08:29.000000000 +0100 +@@ -11,22 +11,24 @@ BEGIN { + } + + 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 -uprNB perl-5.8.8/lib/Test/Simple/t/missing.t /home/marca/Desktop/Test-Simple-0.78/t/missing.t +--- perl-5.8.8/lib/Test/Simple/t/missing.t 2005-09-26 18:58:26.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/missing.t 2006-09-04 10:23:12.000000000 +0200 +@@ -43,7 +43,7 @@ OUT + + My::Test::is($$err, < 51; ++use Test::More tests => 50; + + # Make sure we don't mess with $@ or $!. Test at bottom. + my $Err = "this should not be touched"; +@@ -15,7 +16,8 @@ my $Errno = 42; + $@ = $Err; + $! = $Errno; + +-use_ok('Text::Soundex'); ++#use_ok('Dummy'); ++#is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' ); + require_ok('Test::More'); + + +diff -uprNB perl-5.8.8/lib/Test/Simple/t/no_plan.t /home/marca/Desktop/Test-Simple-0.78/t/no_plan.t +--- perl-5.8.8/lib/Test/Simple/t/no_plan.t 2002-01-11 15:23:49.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/no_plan.t 2006-09-04 10:23:12.000000000 +0200 +@@ -1,3 +1,5 @@ ++#!/usr/bin/perl -w ++ + BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; +@@ -8,66 +10,19 @@ BEGIN { + } + } + +-# Can't use Test.pm, that's a 5.005 thing. +-package My::Test; +- +-print "1..12\n"; +- +-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++; +-} +- +- +-package main; +- +-require Test::Simple; +- +-require Test::Simple::Catch; +-my($out, $err) = Test::Simple::Catch::caught(); +- +-eval { +- Test::Simple->import; +-}; ++use Test::More tests => 6; + +-My::Test::ok($$out eq ''); +-My::Test::ok($$err eq ''); +-My::Test::ok($@ eq ''); ++my $tb = Test::Builder->create; ++$tb->level(0); + +-eval { +- Test::Simple->import(tests => undef); +-}; +- +-My::Test::ok($$out eq ''); +-My::Test::ok($$err eq ''); +-My::Test::ok($@ =~ /Got an undefined number of tests/); +- +-eval { +- Test::Simple->import(tests => 0); +-}; +- +-My::Test::ok($$out eq ''); +-My::Test::ok($$err eq ''); +-My::Test::ok($@ =~ /You said to run 0 tests!/); +- +-eval { +- Test::Simple::ok(1); +-}; +-My::Test::ok( $@ =~ /You tried to run a test without a plan!/); +- +- +-END { +- My::Test::ok($$out eq ''); +- My::Test::ok($$err eq ""); +- +- # Prevent Test::Simple from exiting with non zero. +- exit 0; +-} ++#line 19 ++ok !eval { $tb->plan(tests => undef) }; ++is($@, "Got an undefined number of tests at $0 line 19.\n"); ++ ++#line 23 ++ok !eval { $tb->plan(tests => 0) }; ++is($@, "You said to run 0 tests at $0 line 23.\n"); ++ ++#line 27 ++ok !eval { $tb->ok(1) }; ++is( $@, "You tried to run a test without a plan at $0 line 27.\n"); +diff -uprNB perl-5.8.8/lib/Test/Simple/t/output.t /home/marca/Desktop/Test-Simple-0.78/t/output.t +--- perl-5.8.8/lib/Test/Simple/t/output.t 2004-12-01 21:26:53.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/output.t 2007-09-14 04:34:24.000000000 +0200 +@@ -37,7 +37,7 @@ my $Test = Test::Builder->new(); + my $result; + my $tmpfile = 'foo.tmp'; + my $out = $Test->output($tmpfile); +-END { unlink($tmpfile) } ++END { 1 while unlink($tmpfile) } + + ok( defined $out ); + +diff -uprNB perl-5.8.8/lib/Test/Simple/t/overload.t /home/marca/Desktop/Test-Simple-0.78/t/overload.t +--- perl-5.8.8/lib/Test/Simple/t/overload.t 2005-09-26 18:58:26.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/overload.t 2007-03-14 01:14:20.000000000 +0100 +@@ -37,6 +37,12 @@ sub new { + + package main; + ++local $SIG{__DIE__} = sub { ++ my($call_file, $call_line) = (caller)[1,2]; ++ fail("SIGDIE accidentally called"); ++ diag("From $call_file at $call_line"); ++}; ++ + my $obj = Overloaded->new('foo', 42); + isa_ok $obj, 'Overloaded'; + +diff -uprNB perl-5.8.8/lib/Test/Simple/t/plan_bad.t /home/marca/Desktop/Test-Simple-0.78/t/plan_bad.t +--- perl-5.8.8/lib/Test/Simple/t/plan_bad.t 2004-11-29 13:55:52.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/plan_bad.t 2006-09-04 10:23:12.000000000 +0200 +@@ -8,57 +8,27 @@ BEGIN { + } + + +-# Can't use Test.pm, that's a 5.005 thing. +-package My::Test; ++use Test::More tests => 10; ++use Test::Builder; ++my $tb = Test::Builder->create; ++$tb->level(0); + +-print "1..7\n"; +- +-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++; +- +- return $test; +-} +- +- +-sub is ($$;$) { +- my($this, $that, $name) = @_; +- my $test = $this eq $that; +- my $ok = ''; +- $ok .= "not " unless $test; +- $ok .= "ok $test_num"; +- $ok .= " - $name" if defined $name; +- $ok .= "\n"; +- print $ok; +- +- unless( $test ) { +- print "# got \n$this"; +- print "# expected \n$that"; +- } +- $test_num++; +- +- return $test; +-} +- +- +-use Test::More import => ['plan']; +- +-ok !eval { plan tests => 'no_plan'; }; +-is $@, "Number of tests must be a postive integer. You gave it 'no_plan'.\n"; ++ok !eval { $tb->plan( tests => 'no_plan' ); }; ++is $@, sprintf "Number of tests must be a positive integer. You gave it 'no_plan' at %s line %d.\n", $0, __LINE__ - 1; + + my $foo = []; + my @foo = ($foo, 2, 3); +-ok !eval { plan tests => @foo }; +-is $@, "Number of tests must be a postive integer. You gave it '$foo'.\n"; ++ok !eval { $tb->plan( tests => @foo ) }; ++is $@, sprintf "Number of tests must be a positive integer. You gave it '$foo' at %s line %d.\n", $0, __LINE__ - 1; + +-ok !eval { plan tests => 0 }; +-ok !eval { plan tests => -1 }; +-ok !eval { plan tests => '' }; ++#line 25 ++ok !eval { $tb->plan( tests => -1 ) }; ++is $@, "Number of tests must be a positive integer. You gave it '-1' at $0 line 25.\n"; ++ ++#line 29 ++ok !eval { $tb->plan( tests => '' ) }; ++is $@, "You said to run 0 tests at $0 line 29.\n"; ++ ++#line 33 ++ok !eval { $tb->plan( 'wibble' ) }; ++is $@, "plan() doesn't understand wibble at $0 line 33.\n"; +diff -uprNB perl-5.8.8/lib/Test/Simple/t/plan.t /home/marca/Desktop/Test-Simple-0.78/t/plan.t +--- perl-5.8.8/lib/Test/Simple/t/plan.t 2002-08-26 16:14:12.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/plan.t 2006-09-04 10:23:12.000000000 +0200 +@@ -11,9 +11,11 @@ use Test::More; + + plan tests => 4; + eval { plan tests => 4 }; +-like( $@, '/^You tried to plan twice!/', 'disallow double plan' ); ++is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ - 1), ++ 'disallow double plan' ); + eval { plan 'no_plan' }; +-like( $@, '/^You tried to plan twice!/', 'disallow chaning plan' ); ++is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ -1), ++ 'disallow changing plan' ); + + pass('Just testing plan()'); + pass('Testing it some more'); +diff -uprNB perl-5.8.8/lib/Test/Simple/t/pod-coverage.t /home/marca/Desktop/Test-Simple-0.78/t/pod-coverage.t +--- perl-5.8.8/lib/Test/Simple/t/pod-coverage.t 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/pod.t /home/marca/Desktop/Test-Simple-0.78/t/pod.t +--- perl-5.8.8/lib/Test/Simple/t/pod.t 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/reset.t /home/marca/Desktop/Test-Simple-0.78/t/reset.t +--- perl-5.8.8/lib/Test/Simple/t/reset.t 2005-02-05 14:09:20.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/reset.t 2008-02-24 05:31:07.000000000 +0100 +@@ -16,6 +16,11 @@ chdir 't'; + + 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->level == 1, + 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 -uprNB perl-5.8.8/lib/Test/Simple/t/skip.t /home/marca/Desktop/Test-Simple-0.78/t/skip.t +--- perl-5.8.8/lib/Test/Simple/t/skip.t 2002-01-11 15:23:49.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/skip.t 2006-09-04 10:23:12.000000000 +0200 +@@ -7,7 +7,7 @@ BEGIN { + } + } + +-use Test::More tests => 15; ++use Test::More tests => 17; + + # If we skip with the same name, Test::Harness will report it back and + # we won't get lots of false bug reports. +@@ -84,3 +84,15 @@ SKIP: { + pass("This is supposed to run, too"); + } + ++{ ++ my $warning = ''; ++ local $SIG{__WARN__} = sub { $warning .= join "", @_ }; ++ ++ SKIP: { ++ skip 1, "This is backwards" if 1; ++ ++ pass "This does not run"; ++ } ++ ++ like $warning, '/^skip\(\) was passed a non-numeric number of tests/'; ++} +diff -uprNB perl-5.8.8/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t /home/marca/Desktop/Test-Simple-0.78/t/tbm_doesnt_set_exported_to.t +--- perl-5.8.8/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/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 -uprNB perl-5.8.8/lib/Test/Simple/t/tbt_01basic.t /home/marca/Desktop/Test-Simple-0.78/t/tbt_01basic.t +--- perl-5.8.8/lib/Test/Simple/t/tbt_01basic.t 2005-10-09 21:11:02.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/tbt_01basic.t 2006-09-04 10:23:12.000000000 +0200 +@@ -1,12 +1,5 @@ + #!/usr/bin/perl + +-BEGIN { +- if( $ENV{PERL_CORE} ) { +- chdir 't'; +- @INC = '../lib'; +- } +-} +- + use Test::Builder::Tester tests => 9; + use Test::More; + +@@ -29,7 +22,7 @@ ok(2,"two"); + test_test("multiple tests"); + + test_out("not ok 1 - should fail"); +-test_err("# Failed test ($0 at line 35)"); ++test_err("# Failed test ($0 at line 28)"); + test_err("# got: 'foo'"); + test_err("# expected: 'bar'"); + is("foo","bar","should fail"); +@@ -53,7 +46,7 @@ test_test("testing failing on the same l + + + test_out("not ok 1 - name # TODO Something"); +-test_err("# Failed (TODO) test ($0 at line 59)"); ++test_err("# Failed (TODO) test ($0 at line 52)"); + TODO: { + local $TODO = "Something"; + fail("name"); +diff -uprNB perl-5.8.8/lib/Test/Simple/t/tbt_02fhrestore.t /home/marca/Desktop/Test-Simple-0.78/t/tbt_02fhrestore.t +--- perl-5.8.8/lib/Test/Simple/t/tbt_02fhrestore.t 2005-10-09 17:56:44.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/tbt_02fhrestore.t 2006-09-04 10:23:12.000000000 +0200 +@@ -1,12 +1,5 @@ + #!/usr/bin/perl + +-BEGIN { +- if( $ENV{PERL_CORE} ) { +- chdir 't'; +- @INC = '../lib'; +- } +-} +- + use Test::Builder::Tester tests => 4; + use Test::More; + use Symbol; +diff -uprNB perl-5.8.8/lib/Test/Simple/t/tbt_03die.t /home/marca/Desktop/Test-Simple-0.78/t/tbt_03die.t +--- perl-5.8.8/lib/Test/Simple/t/tbt_03die.t 2005-10-09 17:56:56.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/tbt_03die.t 2006-09-04 10:23:12.000000000 +0200 +@@ -1,12 +1,5 @@ + #!/usr/bin/perl + +-BEGIN { +- if( $ENV{PERL_CORE} ) { +- chdir 't'; +- @INC = '../lib'; +- } +-} +- + use Test::Builder::Tester tests => 1; + use Test::More; + +diff -uprNB perl-5.8.8/lib/Test/Simple/t/tbt_04line_num.t /home/marca/Desktop/Test-Simple-0.78/t/tbt_04line_num.t +--- perl-5.8.8/lib/Test/Simple/t/tbt_04line_num.t 2005-10-09 21:13:35.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/tbt_04line_num.t 2006-09-04 10:23:12.000000000 +0200 +@@ -1,15 +1,8 @@ + #!/usr/bin/perl + +-BEGIN { +- if( $ENV{PERL_CORE} ) { +- chdir 't'; +- @INC = '../lib'; +- } +-} +- + use Test::More tests => 3; + use Test::Builder::Tester; + +-is(line_num(),13,"normal line num"); +-is(line_num(-1),13,"line number minus one"); +-is(line_num(+2),17,"line number plus two"); ++is(line_num(),6,"normal line num"); ++is(line_num(-1),6,"line number minus one"); ++is(line_num(+2),10,"line number plus two"); +diff -uprNB perl-5.8.8/lib/Test/Simple/t/tbt_05faildiag.t /home/marca/Desktop/Test-Simple-0.78/t/tbt_05faildiag.t +--- perl-5.8.8/lib/Test/Simple/t/tbt_05faildiag.t 2005-10-09 17:57:21.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/tbt_05faildiag.t 2006-09-04 10:23:12.000000000 +0200 +@@ -1,12 +1,5 @@ + #!/usr/bin/perl + +-BEGIN { +- if( $ENV{PERL_CORE} ) { +- chdir 't'; +- @INC = '../lib'; +- } +-} +- + use Test::Builder::Tester tests => 5; + use Test::More; + +diff -uprNB perl-5.8.8/lib/Test/Simple/t/tbt_06errormess.t /home/marca/Desktop/Test-Simple-0.78/t/tbt_06errormess.t +--- perl-5.8.8/lib/Test/Simple/t/tbt_06errormess.t 2005-10-09 17:57:34.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/tbt_06errormess.t 2006-09-04 10:23:12.000000000 +0200 +@@ -1,12 +1,5 @@ + #!/usr/bin/perl -w + +-BEGIN { +- if( $ENV{PERL_CORE} ) { +- chdir 't'; +- @INC = '../lib'; +- } +-} +- + use Test::More tests => 8; + use Symbol; + use Test::Builder; +@@ -25,8 +18,8 @@ my $output_handle = gensym; + my $error_handle = gensym; + + # and tie them to this package +-my $out = tie *$output_handle, "Test::Tester::Tie", "STDOUT"; +-my $err = tie *$error_handle, "Test::Tester::Tie", "STDERR"; ++my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; ++my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; + + # ooooh, use the test suite + my $t = Test::Builder->new; +diff -uprNB perl-5.8.8/lib/Test/Simple/t/tbt_07args.t /home/marca/Desktop/Test-Simple-0.78/t/tbt_07args.t +--- perl-5.8.8/lib/Test/Simple/t/tbt_07args.t 2005-10-09 17:57:49.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/tbt_07args.t 2006-09-04 10:23:12.000000000 +0200 +@@ -1,12 +1,5 @@ + #!/usr/bin/perl -w + +-BEGIN { +- if( $ENV{PERL_CORE} ) { +- chdir 't'; +- @INC = '../lib'; +- } +-} +- + use Test::More tests => 18; + use Symbol; + use Test::Builder; +@@ -25,8 +18,8 @@ my $output_handle = gensym; + my $error_handle = gensym; + + # and tie them to this package +-my $out = tie *$output_handle, "Test::Tester::Tie", "STDOUT"; +-my $err = tie *$error_handle, "Test::Tester::Tie", "STDERR"; ++my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; ++my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; + + # ooooh, use the test suite + my $t = Test::Builder->new; +diff -uprNB perl-5.8.8/lib/Test/Simple/t/threads.t /home/marca/Desktop/Test-Simple-0.78/t/threads.t +--- perl-5.8.8/lib/Test/Simple/t/threads.t 2004-12-01 21:26:55.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/threads.t 2006-09-04 10:36:16.000000000 +0200 +@@ -9,10 +9,10 @@ BEGIN { + + use Config; + BEGIN { +- unless ( $] >= 5.008 && $Config{'useithreads'} && ++ unless ( $] >= 5.008001 && $Config{'useithreads'} && + eval { require threads; 'threads'->import; 1; }) + { +- print "1..0 # Skip: no threads\n"; ++ print "1..0 # Skip: no working threads\n"; + exit 0; + } + } +diff -uprNB perl-5.8.8/lib/Test/Simple/t/todo.t /home/marca/Desktop/Test-Simple-0.78/t/todo.t +--- perl-5.8.8/lib/Test/Simple/t/todo.t 2005-09-26 18:58:26.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/t/todo.t 2008-02-27 10:37:18.000000000 +0100 +@@ -9,7 +9,7 @@ BEGIN { + + use Test::More; + +-plan tests => 18; ++plan tests => 19; + + + $Why = 'Just testing the todo interface.'; +@@ -69,11 +69,20 @@ TODO: { + # 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 -uprNB perl-5.8.8/lib/Test/Simple/t/try.t /home/marca/Desktop/Test-Simple-0.78/t/try.t +--- perl-5.8.8/lib/Test/Simple/t/try.t 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/try.t 2007-02-11 16:59:26.000000000 +0100 +@@ -0,0 +1,35 @@ ++#!perl -w ++ ++BEGIN { ++ if( $ENV{PERL_CORE} ) { ++ chdir 't'; ++ @INC = ('../lib', 'lib'); ++ } ++ else { ++ unshift @INC, 't/lib'; ++ } ++} ++ ++use strict; ++ ++use Test::More 'no_plan'; ++ ++require Test::Builder; ++my $tb = Test::Builder->new; ++ ++local $SIG{__DIE__} = sub { fail("DIE handler called: @_") }; ++ ++# These should not change; ++local $@ = 42; ++local $! = 23; ++ ++is $tb->_try(sub { 2 }), 2; ++is $tb->_try(sub { return '' }), ''; ++ ++is $tb->_try(sub { die; }), undef; ++ ++is_deeply [$tb->_try(sub { die "Foo\n" }, undef)], ++ [undef, "Foo\n"]; ++ ++is $@, 42; ++cmp_ok $!, '==', 23; +\ No newline at end of file +diff -uprNB perl-5.8.8/lib/Test/Simple/t/utf8.t /home/marca/Desktop/Test-Simple-0.78/t/utf8.t +--- perl-5.8.8/lib/Test/Simple/t/utf8.t 1970-01-01 01:00:00.000000000 +0100 ++++ /home/marca/Desktop/Test-Simple-0.78/t/utf8.t 2008-02-27 10:54:27.000000000 +0100 +@@ -0,0 +1,61 @@ ++#!/usr/bin/perl -w ++ ++BEGIN { ++ if( $ENV{PERL_CORE} ) { ++ chdir 't'; ++ @INC = '../lib'; ++ } ++} ++ ++use strict; ++use warnings; ++ ++ ++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 tests => 5; ++use Test::More skip_all => 'Not yet implemented'; ++ ++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 [PerlIO::get_layers($dest)], ++ [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, [] ); ++} +\ No newline at end of file +diff -uprNB perl-5.8.8/lib/Test/Builder/Module.pm /home/marca/Desktop/Test-Simple-0.78/lib/Test/Builder/Module.pm +--- perl-5.8.8/lib/Test/Builder/Module.pm 2005-09-26 18:58:26.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/lib/Test/Builder/Module.pm 2008-02-27 11:01:46.000000000 +0100 +@@ -1,13 +1,13 @@ + package Test::Builder::Module; + ++use strict; ++ + use Test::Builder; + + require Exporter; +-@ISA = qw(Exporter); ++our @ISA = qw(Exporter); + +-$VERSION = '0.02'; +- +-use strict; ++our $VERSION = '0.78'; + + # 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; + +diff -uprNB perl-5.8.8/lib/Test/Builder/Tester.pm /home/marca/Desktop/Test-Simple-0.78/lib/Test/Builder/Tester.pm +--- perl-5.8.8/lib/Test/Builder/Tester.pm 2005-10-08 10:24:18.000000000 +0200 ++++ /home/marca/Desktop/Test-Simple-0.78/lib/Test/Builder/Tester.pm 2008-02-27 11:01:52.000000000 +0100 +@@ -1,8 +1,7 @@ + package Test::Builder::Tester; + + use strict; +-use vars qw(@EXPORT $VERSION @ISA); +-$VERSION = "1.02"; ++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 ;-) +@@ -102,8 +101,8 @@ my $output_handle = gensym; + my $error_handle = gensym; + + # and tie them to this package +-my $out = tie *$output_handle, "Test::Tester::Tie", "STDOUT"; +-my $err = tie *$error_handle, "Test::Tester::Tie", "STDERR"; ++my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; ++my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; + + #### + # exported functions +@@ -154,7 +153,7 @@ sub _start_testing + $t->no_ending(1); + } + +-=head2 Methods ++=head2 Functions + + These are the six methods that are exported as default. + +@@ -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; +@@ -214,7 +213,7 @@ so + + test_err("# Failed test ($0 at line ".line_num(+1).")"); + +-C exists as a convenience method that can be called ++C exists as a convenience function that can be called + instead. It takes one argument, the offset from the current line that + the line that causes the fail is on. + +@@ -376,7 +375,7 @@ sub test_test + A utility function that returns the line number that the function was + called on. You can pass it an offset which will be added to the + result. This is very useful for working out the correct text of +-diagnostic methods that contain line numbers. ++diagnostic functions that contain line numbers. + + Essentially this is the same as the C<__LINE__> macro, but the + C idiom is arguably nicer. +@@ -442,10 +441,10 @@ sub color + + =head1 BUGS + +-Calls B's C method turning off the ending +-tests. This is needed as otherwise it will trip out because we've run +-more tests than we strictly should have and it'll register any +-failures we had that we were testing for as real failures. ++Calls C<no_ending>> turning off the ending tests. ++This is needed as otherwise it will trip out because we've run more ++tests than we strictly should have and it'll register any failures we ++had that we were testing for as real failures. + + The color function doesn't work unless B is installed + and is compatible with your terminal. +@@ -485,7 +484,7 @@ L, L_translate_Failed_check($check); +- push @{$self->[2]}, ref $check ? $check : "$check\n"; ++ push @{$self->{wanted}}, ref $check ? $check : "$check\n"; + } + } + + +-sub _translate_Failed_check ++sub _translate_Failed_check + { + my($self, $check) = @_; + +- if( $check =~ /\A(.*)# (Failed .*test) \((.*?) at line (\d+)\)\z/ ) { +- $check = qr/\Q$1\E#\s+\Q$2\E.*?\n?.*?\Q$3\E at line \Q$4\E.*\n?/; ++ if( $check =~ /\A(.*)# (Failed .*test) \((.*?) at line (\d+)\)\Z(?!\n)/ ) { ++ $check = "/\Q$1\E#\\s+\Q$2\E.*?\\n?.*?\Qat $3\E line \Q$4\E.*\\n?/"; + } + + return $check; +@@ -524,10 +523,10 @@ sub check + # turn off warnings as these might be undef + local $^W = 0; + +- my @checks = @{$self->[2]}; +- my $got = $self->[1]; ++ my @checks = @{$self->{wanted}}; ++ my $got = $self->{got}; + foreach my $check (@checks) { +- $check = qr/^\Q$check\E/ unless ref $check; ++ $check = "\Q$check\E" unless ($check =~ s,^/(.*)/$,$1, or ref $check); + return 0 unless $got =~ s/^$check//; + } + +@@ -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; + } + } + +@@ -592,26 +591,30 @@ sub complaint + sub reset + { + my $self = shift; +- @$self = ($self->[0], '', []); ++ %$self = ( ++ type => $self->{type}, ++ got => '', ++ wanted => [], ++ ); + } + + + sub got + { + my $self = shift; +- return $self->[1]; ++ return $self->{got}; + } + + sub wanted + { + my $self = shift; +- return $self->[2]; ++ return $self->{wanted}; + } + + sub type + { + my $self = shift; +- return $self->[0]; ++ return $self->{type}; + } + + ### +@@ -620,13 +623,16 @@ sub type + + sub PRINT { + my $self = shift; +- $self->[1] .= join '', @_; ++ $self->{got} .= join '', @_; + } + + sub TIEHANDLE { + my($class, $type) = @_; + +- my $self = bless [$type], $class; ++ my $self = bless { ++ type => $type ++ }, $class; ++ + $self->reset; + + return $self; diff --git a/perl-5.8.8-rhbz238581.patch b/perl-5.8.8-rhbz238581.patch new file mode 100644 index 0000000..e8c87f2 --- /dev/null +++ b/perl-5.8.8-rhbz238581.patch @@ -0,0 +1,13 @@ +diff -up perl-5.8.8/ext/Socket/Socket.xs.crr perl-5.8.8/ext/Socket/Socket.xs +--- perl-5.8.8/ext/Socket/Socket.xs.crr 2005-07-08 17:56:17.000000000 +0200 ++++ perl-5.8.8/ext/Socket/Socket.xs 2008-03-19 14:24:02.000000000 +0100 +@@ -236,7 +236,8 @@ inet_aton(host) + (*host != '\0') && + inet_aton(host, &ip_address); + +- if (!ok && (phe = gethostbyname(host))) { ++ if (!ok && (phe = gethostbyname(host)) && ++ phe->h_addrtype == AF_INET && phe->h_length == 4) { + Copy( phe->h_addr, &ip_address, phe->h_length, char ); + ok = 1; + } diff --git a/perl.spec b/perl.spec index b4b987b..144de02 100644 --- a/perl.spec +++ b/perl.spec @@ -24,7 +24,7 @@ Name: perl Version: %{perl_version} -Release: 37%{?dist} +Release: 38%{?dist} Epoch: %{perl_epoch} Summary: The Perl programming language Group: Development/Languages @@ -136,12 +136,16 @@ Patch45: perl-5.8.8-rhbz#431774.patch Patch46: perl-5.8.8-Scalar-Util-19.patch # 431774 CGI.pm Version 3.15 Contains Broken File Upload Method Patch47: perl-5.8.8-CGI-3.29.patch +# update Test::Simple +Patch48: perl-5.8.8-TestSimple0.78.patch +# beter check of gethostbyname, fixed in upstream +Patch49: perl-5.8.8-rhbz238581.patch BuildRoot: %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n) BuildRequires: tcsh, dos2unix, man, groff BuildRequires: gdbm-devel, db4-devel # Temporary fix for broken buildroots: -BuildRequires: gawk +#BuildRequires: gawk # The long line of Perl provides. @@ -410,6 +414,8 @@ upstream tarball from perl.org. %patch45 -p1 %patch46 -p1 %patch47 -p1 +%patch48 -p1 +%patch49 -p1 # # Candidates for doc recoding (need case by case review): @@ -811,6 +817,11 @@ make test # Nothing. Nada. Zilch. Zarro. Uh uh. Nope. Sorry. %changelog +* Wed Mar 19 2008 Marcela Maslanova - 4:5.8.8-38 +- 434865 upgrade Test::Simple +- turn off test on loading Dummy in More.t, can't find module (path problem?) +- 238581: careless use of gethostbyname() in Socket.xs + * Thu Mar 13 2008 Marcela Maslanova - 4:5.8.8-37 - update CGI, because of broken upload method #431774