cpan/Test-Simple/lib/Test2/IPC.pm

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