15759b3d2Safresh1package Test2::IPC; 25759b3d2Safresh1use strict; 35759b3d2Safresh1use warnings; 45759b3d2Safresh1 5*5486feefSafresh1our $VERSION = '1.302199'; 65759b3d2Safresh1 75759b3d2Safresh1 85759b3d2Safresh1use Test2::API::Instance; 95759b3d2Safresh1use Test2::Util qw/get_tid/; 105759b3d2Safresh1use Test2::API qw{ 11f3efcd01Safresh1 test2_in_preload 125759b3d2Safresh1 test2_init_done 135759b3d2Safresh1 test2_ipc 145759b3d2Safresh1 test2_has_ipc 155759b3d2Safresh1 test2_ipc_enable_polling 165759b3d2Safresh1 test2_pid 175759b3d2Safresh1 test2_stack 185759b3d2Safresh1 test2_tid 195759b3d2Safresh1 context 205759b3d2Safresh1}; 215759b3d2Safresh1 22f3efcd01Safresh1# Make sure stuff is finalized before anyone tried to fork or start a new thread. 23f3efcd01Safresh1{ 24f3efcd01Safresh1 # Avoid warnings if things are loaded at run-time 25f3efcd01Safresh1 no warnings 'void'; 26f3efcd01Safresh1 INIT { 27f3efcd01Safresh1 use warnings 'void'; 28f3efcd01Safresh1 context()->release() unless test2_in_preload(); 29f3efcd01Safresh1 } 30f3efcd01Safresh1} 31f3efcd01Safresh1 325759b3d2Safresh1use Carp qw/confess/; 335759b3d2Safresh1 345759b3d2Safresh1our @EXPORT_OK = qw/cull/; 355759b3d2Safresh1BEGIN { require Exporter; our @ISA = qw(Exporter) } 365759b3d2Safresh1 375759b3d2Safresh1sub unimport { Test2::API::test2_ipc_disable() } 385759b3d2Safresh1 395759b3d2Safresh1sub import { 405759b3d2Safresh1 goto &Exporter::import if test2_has_ipc || !test2_init_done(); 415759b3d2Safresh1 425759b3d2Safresh1 confess "IPC is disabled" if Test2::API::test2_ipc_disabled(); 435759b3d2Safresh1 confess "Cannot add IPC in a child process (" . test2_pid() . " vs $$)" if test2_pid() != $$; 445759b3d2Safresh1 confess "Cannot add IPC in a child thread (" . test2_tid() . " vs " . get_tid() . ")" if test2_tid() != get_tid(); 455759b3d2Safresh1 465759b3d2Safresh1 Test2::API::_set_ipc(_make_ipc()); 475759b3d2Safresh1 apply_ipc(test2_stack()); 485759b3d2Safresh1 495759b3d2Safresh1 goto &Exporter::import; 505759b3d2Safresh1} 515759b3d2Safresh1 525759b3d2Safresh1sub _make_ipc { 535759b3d2Safresh1 # Find a driver 545759b3d2Safresh1 my ($driver) = Test2::API::test2_ipc_drivers(); 555759b3d2Safresh1 unless ($driver) { 565759b3d2Safresh1 require Test2::IPC::Driver::Files; 575759b3d2Safresh1 $driver = 'Test2::IPC::Driver::Files'; 585759b3d2Safresh1 } 595759b3d2Safresh1 605759b3d2Safresh1 return $driver->new(); 615759b3d2Safresh1} 625759b3d2Safresh1 635759b3d2Safresh1sub apply_ipc { 645759b3d2Safresh1 my $stack = shift; 655759b3d2Safresh1 665759b3d2Safresh1 my ($root) = @$stack; 675759b3d2Safresh1 685759b3d2Safresh1 return unless $root; 695759b3d2Safresh1 705759b3d2Safresh1 confess "Cannot add IPC in a child process" if $root->pid != $$; 715759b3d2Safresh1 confess "Cannot add IPC in a child thread" if $root->tid != get_tid(); 725759b3d2Safresh1 735759b3d2Safresh1 my $ipc = $root->ipc || test2_ipc() || _make_ipc(); 745759b3d2Safresh1 755759b3d2Safresh1 # Add the IPC to all hubs 765759b3d2Safresh1 for my $hub (@$stack) { 775759b3d2Safresh1 my $has = $hub->ipc; 785759b3d2Safresh1 confess "IPC Mismatch!" if $has && $has != $ipc; 795759b3d2Safresh1 next if $has; 805759b3d2Safresh1 $hub->set_ipc($ipc); 815759b3d2Safresh1 $ipc->add_hub($hub->hid); 825759b3d2Safresh1 } 835759b3d2Safresh1 845759b3d2Safresh1 test2_ipc_enable_polling(); 855759b3d2Safresh1 865759b3d2Safresh1 return $ipc; 875759b3d2Safresh1} 885759b3d2Safresh1 895759b3d2Safresh1sub cull { 905759b3d2Safresh1 my $ctx = context(); 915759b3d2Safresh1 $ctx->hub->cull; 925759b3d2Safresh1 $ctx->release; 935759b3d2Safresh1} 945759b3d2Safresh1 955759b3d2Safresh11; 965759b3d2Safresh1 975759b3d2Safresh1__END__ 985759b3d2Safresh1 995759b3d2Safresh1=pod 1005759b3d2Safresh1 1015759b3d2Safresh1=encoding UTF-8 1025759b3d2Safresh1 1035759b3d2Safresh1=head1 NAME 1045759b3d2Safresh1 1055759b3d2Safresh1Test2::IPC - Turn on IPC for threading or forking support. 1065759b3d2Safresh1 1075759b3d2Safresh1=head1 SYNOPSIS 1085759b3d2Safresh1 1095759b3d2Safresh1You should C<use Test2::IPC;> as early as possible in your test file. If you 1105759b3d2Safresh1import this module after API initialization it will attempt to retrofit IPC 1115759b3d2Safresh1onto the existing hubs. 1125759b3d2Safresh1 1135759b3d2Safresh1=head2 DISABLING IT 1145759b3d2Safresh1 1155759b3d2Safresh1You can use C<no Test2::IPC;> to disable IPC for good. You can also use the 1165759b3d2Safresh1T2_NO_IPC env var. 1175759b3d2Safresh1 1185759b3d2Safresh1=head1 EXPORTS 1195759b3d2Safresh1 1205759b3d2Safresh1All exports are optional. 1215759b3d2Safresh1 1225759b3d2Safresh1=over 4 1235759b3d2Safresh1 1245759b3d2Safresh1=item cull() 1255759b3d2Safresh1 1265759b3d2Safresh1Cull allows you to collect results from other processes or threads on demand. 1275759b3d2Safresh1 1285759b3d2Safresh1=back 1295759b3d2Safresh1 1305759b3d2Safresh1=head1 SOURCE 1315759b3d2Safresh1 1325759b3d2Safresh1The source code repository for Test2 can be found at 133*5486feefSafresh1L<https://github.com/Test-More/test-more/>. 1345759b3d2Safresh1 1355759b3d2Safresh1=head1 MAINTAINERS 1365759b3d2Safresh1 1375759b3d2Safresh1=over 4 1385759b3d2Safresh1 1395759b3d2Safresh1=item Chad Granum E<lt>exodist@cpan.orgE<gt> 1405759b3d2Safresh1 1415759b3d2Safresh1=back 1425759b3d2Safresh1 1435759b3d2Safresh1=head1 AUTHORS 1445759b3d2Safresh1 1455759b3d2Safresh1=over 4 1465759b3d2Safresh1 1475759b3d2Safresh1=item Chad Granum E<lt>exodist@cpan.orgE<gt> 1485759b3d2Safresh1 1495759b3d2Safresh1=back 1505759b3d2Safresh1 1515759b3d2Safresh1=head1 COPYRIGHT 1525759b3d2Safresh1 153256a93a4Safresh1Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>. 1545759b3d2Safresh1 1555759b3d2Safresh1This program is free software; you can redistribute it and/or 1565759b3d2Safresh1modify it under the same terms as Perl itself. 1575759b3d2Safresh1 158*5486feefSafresh1See L<https://dev.perl.org/licenses/> 1595759b3d2Safresh1 1605759b3d2Safresh1=cut 161