summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/IPC.pm
blob: e9d29cca25f1dcc9db1ea63110fb000af31bbfb2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
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