summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm')
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm95
1 files changed, 93 insertions, 2 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm
index 8193b07366..6c517415bd 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/API.pm
@@ -9,14 +9,44 @@ BEGIN {
$ENV{TEST2_ACTIVE} = 1;
}
-our $VERSION = '1.302162';
+our $VERSION = '1.302175';
my $INST;
my $ENDING = 0;
-sub test2_set_is_end { ($ENDING) = @_ ? @_ : (1) }
+sub test2_unset_is_end { $ENDING = 0 }
sub test2_get_is_end { $ENDING }
+sub test2_set_is_end {
+ my $before = $ENDING;
+ ($ENDING) = @_ ? @_ : (1);
+
+ # Only send the event in a transition from false to true
+ return if $before;
+ return unless $ENDING;
+
+ return unless $INST;
+ my $stack = $INST->stack or return;
+ my $root = $stack->root or return;
+
+ return unless $root->count;
+
+ return unless $$ == $INST->pid;
+ return unless get_tid() == $INST->tid;
+
+ my $trace = Test2::EventFacet::Trace->new(
+ frame => [__PACKAGE__, __FILE__, __LINE__, __PACKAGE__ . '::test2_set_is_end'],
+ );
+ my $ctx = Test2::API::Context->new(
+ trace => $trace,
+ hub => $root,
+ );
+
+ $ctx->send_ev2(control => { phase => 'END', details => 'Transition to END phase' });
+
+ 1;
+}
+
use Test2::API::Instance(\$INST);
# Set the exit status
@@ -85,8 +115,10 @@ our @EXPORT_OK = qw{
test2_start_preload
test2_stop_preload
test2_in_preload
+ test2_is_testing_done
test2_set_is_end
+ test2_unset_is_end
test2_get_is_end
test2_pid
@@ -176,6 +208,27 @@ sub test2_ipc_wait_enable { $INST->set_no_wait(0) }
sub test2_ipc_wait_disable { $INST->set_no_wait(1) }
sub test2_ipc_wait_enabled { !$INST->no_wait }
+sub test2_is_testing_done {
+ # No instance? VERY DONE!
+ return 1 unless $INST;
+
+ # No stack? tests must be done, it is created pretty early
+ my $stack = $INST->stack or return 1;
+
+ # Nothing on the stack, no root hub yet, likely have not started testing
+ return 0 unless @$stack;
+
+ # Stack has a slot for the root hub (see above) but it is undefined, likely
+ # garbage collected, test is done
+ my $root_hub = $stack->[0] or return 1;
+
+ # If the root hub is ended than testing is done.
+ return 1 if $root_hub->ended;
+
+ # Looks like we are still testing!
+ return 0;
+}
+
sub test2_no_wait {
$INST->set_no_wait(@_) if @_;
$INST->no_wait;
@@ -322,6 +375,23 @@ sub context {
my $stack = $params{stack} || $STACK;
my $hub = $params{hub} || (@$stack ? $stack->[-1] : $stack->top);
+
+ # Catch an edge case where we try to get context after the root hub has
+ # been garbage collected resulting in a stack that has a single undef
+ # hub
+ if (!$hub && !exists($params{hub}) && @$stack) {
+ my $msg = Carp::longmess("Attempt to get Test2 context after testing has completed (did you attempt a testing event after done_testing?)");
+
+ # The error message is usually masked by the global destruction, so we have to print to STDER
+ print STDERR $msg;
+
+ # Make sure this is a failure, we are probably already in END, so set $? to change the exit code
+ $? = 1;
+
+ # Now we actually die to interrupt the program flow and avoid undefined his warnings
+ die $msg;
+ }
+
my $hid = $hub->{hid};
my $current = $CONTEXTS->{$hid};
@@ -814,6 +884,7 @@ C<intercept { ... }> which only lets you see events as the main hub sees them.
test2_ipc
test2_formatter_set
test2_formatter
+ test2_is_testing_done
};
my $init = test2_init_done();
@@ -1257,6 +1328,26 @@ Check if Test2 believes it is the END phase.
This will return the global L<Test2::API::Stack> instance. If this has not
yet been initialized it will be initialized now.
+=item $bool = test2_is_testing_done()
+
+This will return true if testing is complete and no other events should be
+sent. This is useful in things like warning handlers where you might want to
+turn warnings into events, but need them to start acting like normal warnings
+when testing is done.
+
+ $SIG{__WARN__} = sub {
+ my ($warning) = @_;
+
+ if (test2_is_testing_done()) {
+ warn @_;
+ }
+ else {
+ my $ctx = context();
+ ...
+ $ctx->release
+ }
+ }
+
=item test2_ipc_disable
Disable IPC.