xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Simple/lib/Test2/IPC.pm (revision 5486feefcc8cb79b19e014ab332cc5dfd05b3b33)
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