From: Steve Peters Date: Fri, 29 Feb 2008 03:10:59 +0000 (+0000) Subject: Upgrade to Test-Simple-0.75 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=705e6672c0ccf52713e889d1ae975c3d80f2aa4b;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Test-Simple-0.75 p4raw-id: //depot/perl@33391 --- diff --git a/MANIFEST b/MANIFEST index 469c9c1..2813550 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2696,6 +2696,7 @@ lib/Test/Simple/README Test::Simple README lib/Test/Simple/t/00test_harness_check.t Test::Simple test lib/Test/Simple/t/bad_plan.t Test::Builder plan() test lib/Test/Simple/t/bail_out.t Test::Builder BAIL_OUT test +lib/Test/Simple/t/BEGIN_require_ok.t Test::More require_ok() testing lib/Test/Simple/t/BEGIN_use_ok.t Test::More use_ok() testing lib/Test/Simple/t/buffer.t Test::Builder buffering test lib/Test/Simple/t/Builder.t Test::Builder tests diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm index c385452..b2bb376 100644 --- a/lib/Test/Builder.pm +++ b/lib/Test/Builder.pm @@ -198,7 +198,7 @@ sub reset { $self->_dup_stdhandles unless $^C; - return undef; + return; } =back @@ -401,9 +401,7 @@ sub ok { Very confusing. ERR - my($pack, $file, $line) = $self->caller; - - my $todo = $self->todo($pack); + my $todo = $self->todo(); $self->_unoverload_str(\$todo); my $out; @@ -448,13 +446,14 @@ ERR my $msg = $todo ? "Failed (TODO)" : "Failed"; $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE}; - if( defined $name ) { - $self->diag(qq[ $msg test '$name'\n]); - $self->diag(qq[ at $file line $line.\n]); - } - else { - $self->diag(qq[ $msg test at $file line $line.\n]); - } + my(undef, $file, $line) = $self->caller; + if( defined $name ) { + $self->diag(qq[ $msg test '$name'\n]); + $self->diag(qq[ at $file line $line.\n]); + } + else { + $self->diag(qq[ $msg test at $file line $line.\n]); + } } return $test ? 1 : 0; @@ -705,7 +704,8 @@ sub cmp_ok { my $code = $self->_caller_context; - # Yes, it has to look like this or 5.4.5 won't see the #line directive. + # Yes, it has to look like this or 5.4.5 won't see the #line + # directive. # Don't ask me, man, I just work here. $test = eval " $code" . "\$got $type \$expect;"; @@ -960,7 +960,8 @@ sub _regex_ok { local($@, $!, $SIG{__DIE__}); # isolate eval - # Yes, it has to look like this or 5.4.5 won't see the #line directive. + # Yes, it has to look like this or 5.4.5 won't see the #line + # directive. # Don't ask me, man, I just work here. $test = eval " $code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0}; @@ -1149,7 +1150,7 @@ foreach my $attribute (qw(No_Header No_Ending No_Diag)) { return $self->{$attribute}; }; - no strict 'refs'; + no strict 'refs'; ## no critic *{__PACKAGE__.'::'.$method} = $code; } @@ -1336,10 +1337,9 @@ sub _new_fh { $fh = $file_or_fh; } else { - $fh = do { local *FH }; - open $fh, ">$file_or_fh" or + open $fh, ">", $file_or_fh or $self->croak("Can't open test output log $file_or_fh: $!"); - _autoflush($fh); + _autoflush($fh); } return $fh; @@ -1578,7 +1578,7 @@ sub todo { $pack = $pack || $self->exported_to || $self->caller($Level); return 0 unless $pack; - no strict 'refs'; + no strict 'refs'; ## no critic return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'} : 0; } diff --git a/lib/Test/Builder/Module.pm b/lib/Test/Builder/Module.pm index 7fa0a5c..82d19c6 100644 --- a/lib/Test/Builder/Module.pm +++ b/lib/Test/Builder/Module.pm @@ -1,13 +1,13 @@ package Test::Builder::Module; +use strict; + use Test::Builder; require Exporter; -@ISA = qw(Exporter); +our @ISA = qw(Exporter); -$VERSION = '0.74'; - -use strict; +our $VERSION = '0.75'; # 5.004's Exporter doesn't have export_to_level. my $_export_to_level = sub { diff --git a/lib/Test/Builder/Tester.pm b/lib/Test/Builder/Tester.pm index 487b16d..ef66d66 100644 --- a/lib/Test/Builder/Tester.pm +++ b/lib/Test/Builder/Tester.pm @@ -1,8 +1,7 @@ package Test::Builder::Tester; use strict; -use vars qw(@EXPORT $VERSION @ISA); -$VERSION = "1.11"; +our $VERSION = "1.12"; use Test::Builder; use Symbol; @@ -56,9 +55,9 @@ my $t = Test::Builder->new; ### use Exporter; -@ISA = qw(Exporter); +our @ISA = qw(Exporter); -@EXPORT = qw(test_out test_err test_fail test_diag test_test line_num); +our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num); # _export_to_level and import stolen directly from Test::More. I am # the king of cargo cult programming ;-) @@ -188,7 +187,7 @@ output filehandles) =cut -sub test_out(@) +sub test_out { # do we need to do any setup? _start_testing() unless $testing; @@ -196,7 +195,7 @@ sub test_out(@) $out->expect(@_) } -sub test_err(@) +sub test_err { # do we need to do any setup? _start_testing() unless $testing; @@ -549,36 +548,36 @@ sub complaint if (Test::Builder::Tester::color) { # get color - eval "require Term::ANSIColor"; + eval { require Term::ANSIColor }; unless ($@) { - # colours + # colours - my $green = Term::ANSIColor::color("black"). - Term::ANSIColor::color("on_green"); + my $green = Term::ANSIColor::color("black"). + Term::ANSIColor::color("on_green"); my $red = Term::ANSIColor::color("black"). Term::ANSIColor::color("on_red"); - my $reset = Term::ANSIColor::color("reset"); + my $reset = Term::ANSIColor::color("reset"); - # work out where the two strings start to differ - my $char = 0; - $char++ while substr($got, $char, 1) eq substr($wanted, $char, 1); + # 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; + # 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 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; + # 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; + # rebuild the strings + $got = $start . $gotend; + $wanted = $start . $wantedend; } } diff --git a/lib/Test/More.pm b/lib/Test/More.pm index abdd55e..a33be4c 100644 --- a/lib/Test/More.pm +++ b/lib/Test/More.pm @@ -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.74'; +$VERSION = '0.75'; $VERSION = eval $VERSION; # make the alpha version come out as a number use Test::Builder::Module; @@ -659,30 +658,28 @@ sub use_ok ($;@) { my($pack,$filename,$line) = caller; - # Work around a glitch in $@ and eval - my $eval_error; - { - local($@,$!,$SIG{__DIE__}); # isolate eval - - if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) { - # probably a version check. Perl needs to see the bare number - # for it to work with non-Exporter based modules. - eval <ok( !$eval_error, "use $module;" ); + my($eval_result, $eval_error) = _eval($code, \@imports); + my $ok = $tb->ok( $eval_result, "use $module;" ); + unless( $ok ) { chomp $eval_error; $@ =~ s{^BEGIN failed--compilation aborted at .*$} @@ -697,6 +694,20 @@ DIAGNOSTIC return $ok; } + +sub _eval { + my($code) = shift; + my @args = @_; + + # Work around oddities surrounding resetting of $@ by immediately + # storing it. + local($@,$!,$SIG{__DIE__}); # isolate eval + my $eval_result = eval $code; + my $eval_error = $@; + + return($eval_result, $eval_error); +} + =item B require_ok($module); @@ -716,20 +727,20 @@ sub require_ok ($) { # Module names must be barewords, files not. $module = qq['$module'] unless _is_module_name($module); - local($!, $@, $SIG{__DIE__}); # isolate eval - local $SIG{__DIE__}; - eval <ok( !$@, "require $module;" ); + my($eval_result, $eval_error) = _eval($code); + my $ok = $tb->ok( $eval_result, "require $module;" ); unless( $ok ) { - chomp $@; + chomp $eval_error; $tb->diag(< This behavior may go away in future versions. =item Backwards compatibility -Test::More works with Perls as old as 5.004_05. +Test::More works with Perls as old as 5.6.0. =item Overloaded objects diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm index 1b7e0a7..a070133 100644 --- a/lib/Test/Simple.pm +++ b/lib/Test/Simple.pm @@ -4,7 +4,7 @@ use 5.004; use strict 'vars'; use vars qw($VERSION @ISA @EXPORT); -$VERSION = '0.74'; +$VERSION = '0.75'; $VERSION = eval $VERSION; # make the alpha version come out as a number use Test::Builder::Module; diff --git a/lib/Test/Simple/t/BEGIN_require_ok.t b/lib/Test/Simple/t/BEGIN_require_ok.t new file mode 100644 index 0000000..289ebc5 --- /dev/null +++ b/lib/Test/Simple/t/BEGIN_require_ok.t @@ -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 --git a/lib/Test/Simple/t/is_deeply_with_threads.t b/lib/Test/Simple/t/is_deeply_with_threads.t index a9e2e5a..cf6b6ba 100644 --- a/lib/Test/Simple/t/is_deeply_with_threads.t +++ b/lib/Test/Simple/t/is_deeply_with_threads.t @@ -22,12 +22,17 @@ BEGIN { print "1..0 # Skip: no working threads\n"; exit 0; } + + unless ( $ENV{AUTHOR_TESTING} ) { + print "1..0 # Skip: many perls have broken threads\n"; + exit 0; + } } use Test::More; my $Num_Threads = 5; -plan tests => $Num_Threads * 100 + 5; +plan tests => $Num_Threads * 100 + 6; sub do_one_thread { @@ -56,3 +61,5 @@ for my $t (@kids) { my $rc = $t->join(); cmp_ok( $rc, '==', 42, "threads exit status is $rc" ); } + +pass("End of test"); diff --git a/lib/Test/Simple/t/todo.t b/lib/Test/Simple/t/todo.t index 3e5ad02..6ea51a6 100644 --- a/lib/Test/Simple/t/todo.t +++ b/lib/Test/Simple/t/todo.t @@ -9,7 +9,7 @@ BEGIN { use Test::More; -plan tests => 18; +plan tests => 19; $Why = 'Just testing the todo interface.'; @@ -77,3 +77,13 @@ TODO: { "block at $0 line 82\n", 'todo_skip without $how_many warning' ); } + + +{ + Test::More->builder->exported_to("Wibble"); + $Wibble::TODO = ''; # shut up used only once warning + TODO: { + local $Wibble::TODO = $Why; + fail("TODO honors exported_to()"); + } +} \ No newline at end of file