161 lines
3.1 KiB
Perl
161 lines
3.1 KiB
Perl
|
package Test2::IPC;
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
|
||
|
|
our $VERSION = '1.302175';
|
||
|
|
|
||
|
|
|
||
|
|
use Test2::API::Instance;
|
||
|
|
use Test2::Util qw/get_tid/;
|
||
|
|
use Test2::API qw{
|
||
|
|
test2_in_preload
|
||
|
|
test2_init_done
|
||
|
|
test2_ipc
|
||
|
|
test2_has_ipc
|
||
|
|
test2_ipc_enable_polling
|
||
|
|
test2_pid
|
||
|
|
test2_stack
|
||
|
|
test2_tid
|
||
|
|
context
|
||
|
|
};
|
||
|
|
|
||
|
|
# Make sure stuff is finalized before anyone tried to fork or start a new thread.
|
||
|
|
{
|
||
|
|
# Avoid warnings if things are loaded at run-time
|
||
|
|
no warnings 'void';
|
||
|
|
INIT {
|
||
|
|
use warnings 'void';
|
||
|
|
context()->release() unless test2_in_preload();
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
use Carp qw/confess/;
|
||
|
|
|
||
|
|
our @EXPORT_OK = qw/cull/;
|
||
|
|
BEGIN { require Exporter; our @ISA = qw(Exporter) }
|
||
|
|
|
||
|
|
sub unimport { Test2::API::test2_ipc_disable() }
|
||
|
|
|
||
|
|
sub import {
|
||
|
|
goto &Exporter::import if test2_has_ipc || !test2_init_done();
|
||
|
|
|
||
|
|
confess "IPC is disabled" if Test2::API::test2_ipc_disabled();
|
||
|
|
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.
|
||
|
|
|
||
|
|
=head2 DISABLING IT
|
||
|
|
|
||
|
|
You can use C<no Test2::IPC;> to disable IPC for good. You can also use the
|
||
|
|
T2_NO_IPC env var.
|
||
|
|
|
||
|
|
=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 2019 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
|