diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test/Tester/Capture.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Test/Tester/Capture.pm | 18 |
1 files changed, 17 insertions, 1 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test/Tester/Capture.pm b/Master/tlpkg/tlperl/lib/Test/Tester/Capture.pm index 00e12e6458e..d8eb170b6c5 100644 --- a/Master/tlpkg/tlperl/lib/Test/Tester/Capture.pm +++ b/Master/tlpkg/tlperl/lib/Test/Tester/Capture.pm @@ -2,6 +2,9 @@ use strict; package Test::Tester::Capture; +our $VERSION = '1.302073'; + + use Test::Builder; use vars qw( @ISA ); @@ -42,6 +45,8 @@ sub new sub ok { my($self, $test, $name) = @_; + my $ctx = $self->ctx; + # $test might contain an object which we don't want to accidentally # store, so we turn it into a boolean. $test = $test ? 1 : 0; @@ -51,7 +56,7 @@ sub ok { my($pack, $file, $line) = $self->caller; - my $todo = $self->todo($pack); + my $todo = $self->todo(); my $result = {}; share($result); @@ -92,6 +97,8 @@ sub ok { $result->{_level} = $Test::Builder::Level; $result->{_depth} = Test::Tester::find_run_tests(); + $ctx->release; + return $test ? 1 : 0; } @@ -99,6 +106,8 @@ sub skip { my($self, $why) = @_; $why ||= ''; + my $ctx = $self->ctx; + lock($Curr_Test); $Curr_Test++; @@ -116,6 +125,7 @@ sub skip { ); $Test_Results[$Curr_Test-1] = \%result; + $ctx->release; return 1; } @@ -123,6 +133,8 @@ sub todo_skip { my($self, $why) = @_; $why ||= ''; + my $ctx = $self->ctx; + lock($Curr_Test); $Curr_Test++; @@ -141,6 +153,7 @@ sub todo_skip { $Test_Results[$Curr_Test-1] = \%result; + $ctx->release; return 1; } @@ -151,6 +164,8 @@ sub diag { # Prevent printing headers when compiling (i.e. -c) return if $^C; + my $ctx = $self->ctx; + # Escape each line with a #. foreach (@msgs) { $_ = 'undef' unless defined; @@ -162,6 +177,7 @@ sub diag { $result->{diag} .= join("", @msgs); + $ctx->release; return 0; } |