File Coverage

blib/lib/Test2/IPC/Driver.pm
Criterion Covered Total %
statement 32 33 96.9
branch 5 6 83.3
condition n/a
subroutine 10 11 90.9
pod 3 3 100.0
total 50 53 94.3


line stmt bran cond sub pod time code
1             package Test2::IPC::Driver;
2 22     22   90 use strict;
  22         23  
  22         528  
3 22     22   67 use warnings;
  22         16  
  22         695  
4              
5             our $VERSION = '0.000042';
6              
7 22     22   61 use Carp qw/confess longmess/;
  22         20  
  22         930  
8 22     22   383 use Test2::Util::HashBase qw{no_fatal};
  22         25  
  22         96  
9              
10 22     22   486 use Test2::API qw/test2_ipc_add_driver/;
  22         28  
  22         2099  
11              
12             my %ADDED;
13             sub import {
14 4     4   22 my $class = shift;
15 4 50       8 return if $class eq __PACKAGE__;
16 4 100       9 return if $ADDED{$class}++;
17 1         3 test2_ipc_add_driver($class);
18             }
19              
20 0     0 1 0 sub use_shm { 0 }
21              
22             for my $meth (qw/send cull add_hub drop_hub waiting is_viable/) {
23 22     22   85 no strict 'refs';
  22         21  
  22         3464  
24             *$meth = sub {
25 6     6   70 my $thing = shift;
26 6         569 confess "'$thing' did not define the required method '$meth'."
27             };
28             }
29              
30             # Print the error and call exit. We are not using 'die' cause this is a
31             # catastophic error that should never be caught. If we get here it
32             # means some serious shit has happened in a child process, the only way
33             # to inform the parent may be to exit false.
34              
35             sub abort {
36 14     14 1 1841 my $self = shift;
37 14         24 chomp(my ($msg) = @_);
38 14         50 print STDERR "IPC Fatal Error: $msg\n";
39 14         21 print STDOUT "not ok - IPC Fatal Error\n";
40              
41 14 100       40 CORE::exit(255) unless $self->no_fatal;
42             }
43              
44             sub abort_trace {
45 4     4 1 18 my $self = shift;
46 4         5 my ($msg) = @_;
47 4         276 $self->abort(longmess($msg));
48             }
49              
50             1;
51              
52             __END__