File Coverage

blib/lib/Test/Mock/Cmd/TestUtils.pm
Criterion Covered Total %
statement 32 34 94.1
branch 8 14 57.1
path n/a
condition n/a
subroutine 6 6 100.0
pod 0 3 0.0
total 46 57 80.7


line stmt bran path cond sub pod time code
1               package Test::Mock::Cmd::TestUtils;
2                
3 7       7   206833 use strict;
  7           21  
  7           333  
4 7       7   46 use warnings;
  7           15  
  7           1885  
5                
6               sub do_in_fork {
7 34       34 0 258 my ( $code, @args ) = @_;
8 34           32785 my $pid = fork();
9 34 50         2252 if ( not defined $pid ) {
    100            
10 0           0 die "Could not fork: $!";
11               }
12               elsif ( $pid == 0 ) {
13 4           1022 $code->(@args);
14 0           0 exit 1;
15               }
16               else {
17 30           15441142 waitpid( $pid, 0 ); # parent
18               }
19               }
20                
21               sub test_more_is_like_return_42 {
22 24       24 0 4387 my ( $got, $expected, $name ) = @_;
23 24 50         138 ref($expected) eq 'Regexp' ? Test::More::like( $got, $expected, $name ) : Test::More::is( $got, $expected, $name );
24 24           13473 return 42;
25               }
26                
27               # use Test::Output; # rt 72976
28               # The Perl::Critic test failures will go away when this temp workaround goes away
29               sub tmp_stdout_like_rt_72976 {
30 42       42 0 60776 my ( $func, $regex, $name ) = @_;
31 42           100 my $output = '';
32               {
33 42           61 unlink "tmp.$$.tmp";
  42           1317  
34                
35 7       7   48 no warnings 'once';
  7           18  
  7           2057  
36 42 50         1110 open OLDOUT, '>&STDOUT' or die "Could not dup STDOUT: $!"; ## no critic
37 42           217 close STDOUT;
38                
39 42 50         4291 open STDOUT, '>', "tmp.$$.tmp" or die "Could not redirect STDOUT: $!";
40                
41               # \$output does not capture system()
42               # open STDOUT, '>', \$output or die "Could not redirect STDOUT: $!";
43                
44 42           172 $func->();
45 38 50         82076 open STDOUT, '>&OLDOUT' or die "Could not restore STDOUT: $!"; ## no critic
46                
47 38 50         5169 open my $fh, '<', "tmp.$$.tmp" or die "Could not open temp file: $!";
48 38           1846 while ( my $line = <$fh> ) {
49 38           631 $output .= $line;
50               }
51 38           444 close $fh;
52                
53 38           5592 unlink "tmp.$$.tmp";
54               }
55                
56               # use Data::Dumper;diag(Dumper([$output,$regex,$name]));
57 38           1819 Test::More::like( $output, $regex, $name );
58               }
59                
60               1;
61                
62               __END__