File Coverage

blib/lib/Test/Exec.pm
Criterion Covered Total %
statement 40 40 100.0
branch 2 2 100.0
condition 4 5 80.0
subroutine 11 11 100.0
pod 2 2 100.0
total 59 60 98.3


line stmt bran cond sub pod time code
1             package Test::Exec;
2              
3 5     5   736017 use strict;
  5         36  
  5         130  
4 5     5   22 use warnings;
  5         9  
  5         99  
5 5     5   95 use 5.010;
  5         15  
6 5     5   29 use Test2::API qw( context );
  5         16  
  5         254  
7 5     5   1659 use Test2::Tools::Process ();
  5         13  
  5         127  
8 5     5   30 use Return::MultiLevel qw( with_return );
  5         6  
  5         256  
9 5     5   26 use base 'Exporter';
  5         7  
  5         1658  
10              
11             # ABSTRACT: Test that some code calls exec without terminating testing
12             our $VERSION = '0.06'; # VERSION
13              
14              
15             our @EXPORT = qw( exec_arrayref never_exec_ok );
16              
17              
18             my $last;
19              
20             sub exec_arrayref(&)
21             {
22 10     10 1 8528 my($code) = @_;
23              
24 10         24 undef $last;
25              
26             return with_return {
27 10     10   157 my($return) = @_;
28             local $Test2::Tools::Process::handlers{exec} = sub {
29 6         44 $last = [caller(1)];
30 6         25 $return->([@_]);
31 10         44 };
32 10         27 $code->();
33 4         762 undef;
34 10         67 };
35             }
36              
37              
38             sub never_exec_ok (&;$)
39             {
40 3     3 1 44035 my($code, $name) = @_;
41              
42 3   100     18 $name ||= 'does not call exec';
43              
44 3     3   17 my $ret = exec_arrayref { $code->() };
  3         8  
45 3         30 my $ok = !defined $ret;
46              
47 3         9 my $ctx = context();
48 3         208 $ctx->ok($ok, $name);
49              
50 3 100 66     518 if(!$ok && $last)
51             {
52 1         4 my(undef, $filename, $line) = @$last;
53 1         6 $ctx->diag("exec at $filename line $line");
54             }
55              
56 3         152 $ctx->release;
57             }
58              
59             1;
60              
61             __END__