5493bd470eab844f0c1ec456a3e0b44acc94aa12
[perl.git] / cpan / Test-Simple / lib / Test2 / IPC.pm
1 package Test2::IPC;
2 use strict;
3 use warnings;
4
5 our $VERSION = '1.302138';
6
7
8 use Test2::API::Instance;
9 use Test2::Util qw/get_tid/;
10 use Test2::API qw{
11     test2_init_done
12     test2_ipc
13     test2_has_ipc
14     test2_ipc_enable_polling
15     test2_pid
16     test2_stack
17     test2_tid
18     context
19 };
20
21 # Make sure stuff is finalized before anyone tried to fork or start a new thread.
22 INIT { context()->release() }
23
24 use Carp qw/confess/;
25
26 our @EXPORT_OK = qw/cull/;
27 BEGIN { require Exporter; our @ISA = qw(Exporter) }
28
29 sub unimport { Test2::API::test2_ipc_disable() }
30
31 sub import {
32     goto &Exporter::import if test2_has_ipc || !test2_init_done();
33
34     confess "IPC is disabled" if Test2::API::test2_ipc_disabled();
35     confess "Cannot add IPC in a child process (" . test2_pid() . " vs $$)" if test2_pid() != $$;
36     confess "Cannot add IPC in a child thread (" . test2_tid() . " vs " . get_tid() . ")"  if test2_tid() != get_tid();
37
38     Test2::API::_set_ipc(_make_ipc());
39     apply_ipc(test2_stack());
40
41     goto &Exporter::import;
42 }
43
44 sub _make_ipc {
45     # Find a driver
46     my ($driver) = Test2::API::test2_ipc_drivers();
47     unless ($driver) {
48         require Test2::IPC::Driver::Files;
49         $driver = 'Test2::IPC::Driver::Files';
50     }
51
52     return $driver->new();
53 }
54
55 sub apply_ipc {
56     my $stack = shift;
57
58     my ($root) = @$stack;
59
60     return unless $root;
61
62     confess "Cannot add IPC in a child process" if $root->pid != $$;
63     confess "Cannot add IPC in a child thread"  if $root->tid != get_tid();
64
65     my $ipc = $root->ipc || test2_ipc() || _make_ipc();
66
67     # Add the IPC to all hubs
68     for my $hub (@$stack) {
69         my $has = $hub->ipc;
70         confess "IPC Mismatch!" if $has && $has != $ipc;
71         next if $has;
72         $hub->set_ipc($ipc);
73         $ipc->add_hub($hub->hid);
74     }
75
76     test2_ipc_enable_polling();
77
78     return $ipc;
79 }
80
81 sub cull {
82     my $ctx = context();
83     $ctx->hub->cull;
84     $ctx->release;
85 }
86
87 1;
88
89 __END__
90
91 =pod
92
93 =encoding UTF-8
94
95 =head1 NAME
96
97 Test2::IPC - Turn on IPC for threading or forking support.
98
99 =head1 SYNOPSIS
100
101 You should C<use Test2::IPC;> as early as possible in your test file. If you
102 import this module after API initialization it will attempt to retrofit IPC
103 onto the existing hubs.
104
105 =head2 DISABLING IT
106
107 You can use C<no Test2::IPC;> to disable IPC for good. You can also use the
108 T2_NO_IPC env var.
109
110 =head1 EXPORTS
111
112 All exports are optional.
113
114 =over 4
115
116 =item cull()
117
118 Cull allows you to collect results from other processes or threads on demand.
119
120 =back
121
122 =head1 SOURCE
123
124 The source code repository for Test2 can be found at
125 F<http://github.com/Test-More/test-more/>.
126
127 =head1 MAINTAINERS
128
129 =over 4
130
131 =item Chad Granum E<lt>exodist@cpan.orgE<gt>
132
133 =back
134
135 =head1 AUTHORS
136
137 =over 4
138
139 =item Chad Granum E<lt>exodist@cpan.orgE<gt>
140
141 =back
142
143 =head1 COPYRIGHT
144
145 Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>.
146
147 This program is free software; you can redistribute it and/or
148 modify it under the same terms as Perl itself.
149
150 See F<http://dev.perl.org/licenses/>
151
152 =cut