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

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