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 23     23   108 use strict;
  23         23  
  23         511  
3 23     23   63 use warnings;
  23         24  
  23         739  
4              
5             our $VERSION = '0.000044';
6              
7 23     23   81 use Carp qw/confess longmess/;
  23         51  
  23         1119  
8 23     23   398 use Test2::Util::HashBase qw{no_fatal};
  23         29  
  23         102  
9              
10 23     23   481 use Test2::API qw/test2_ipc_add_driver/;
  23         27  
  23         2384  
11              
12             my %ADDED;
13             sub import {
14 4     4   24 my $class = shift;
15 4 50       9 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 23     23   109 no strict 'refs';
  23         34  
  23         3608  
24             *$meth = sub {
25 6     6   69 my $thing = shift;
26 6         561 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 1903 my $self = shift;
37 14         24 chomp(my ($msg) = @_);
38 14         46 print STDERR "IPC Fatal Error: $msg\n";
39 14         23 print STDOUT "not ok - IPC Fatal Error\n";
40              
41 14 100       38 CORE::exit(255) unless $self->no_fatal;
42             }
43              
44             sub abort_trace {
45 4     4 1 21 my $self = shift;
46 4         4 my ($msg) = @_;
47 4         290 $self->abort(longmess($msg));
48             }
49              
50             1;
51              
52             __END__