summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Test/Tester/Capture.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test/Tester/Capture.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Test/Tester/Capture.pm18
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;
}