diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test2/IPC.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Test2/IPC.pm | 140 |
1 files changed, 140 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test2/IPC.pm b/Master/tlpkg/tlperl/lib/Test2/IPC.pm new file mode 100755 index 00000000000..92447919c11 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Test2/IPC.pm @@ -0,0 +1,140 @@ +package Test2::IPC; +use strict; +use warnings; + +our $VERSION = '1.302073'; + + +use Test2::API::Instance; +use Test2::Util qw/get_tid/; +use Test2::API qw{ + test2_init_done + test2_ipc + test2_ipc_enable_polling + test2_pid + test2_stack + test2_tid + context +}; + +use Carp qw/confess/; + +our @EXPORT_OK = qw/cull/; +BEGIN { require Exporter; our @ISA = qw(Exporter) } + +sub import { + goto &Exporter::import unless test2_init_done(); + + confess "Cannot add IPC in a child process (" . test2_pid() . " vs $$)" if test2_pid() != $$; + confess "Cannot add IPC in a child thread (" . test2_tid() . " vs " . get_tid() . ")" if test2_tid() != get_tid(); + + Test2::API::_set_ipc(_make_ipc()); + apply_ipc(test2_stack()); + + goto &Exporter::import; +} + +sub _make_ipc { + # Find a driver + my ($driver) = Test2::API::test2_ipc_drivers(); + unless ($driver) { + require Test2::IPC::Driver::Files; + $driver = 'Test2::IPC::Driver::Files'; + } + + return $driver->new(); +} + +sub apply_ipc { + my $stack = shift; + + my ($root) = @$stack; + + return unless $root; + + confess "Cannot add IPC in a child process" if $root->pid != $$; + confess "Cannot add IPC in a child thread" if $root->tid != get_tid(); + + my $ipc = $root->ipc || test2_ipc() || _make_ipc(); + + # Add the IPC to all hubs + for my $hub (@$stack) { + my $has = $hub->ipc; + confess "IPC Mismatch!" if $has && $has != $ipc; + next if $has; + $hub->set_ipc($ipc); + $ipc->add_hub($hub->hid); + } + + test2_ipc_enable_polling(); + + return $ipc; +} + +sub cull { + my $ctx = context(); + $ctx->hub->cull; + $ctx->release; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::IPC - Turn on IPC for threading or forking support. + +=head1 SYNOPSIS + +You should C<use Test2::IPC;> as early as possible in your test file. If you +import this module after API initialization it will attempt to retrofit IPC +onto the existing hubs. + +=head1 EXPORTS + +All exports are optional. + +=over 4 + +=item cull() + +Cull allows you to collect results from other processes or threads on demand. + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut |