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

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