1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
package Test::Mock::Cmd::TestUtils;
use strict;
use warnings;
sub do_in_fork {
my ( $code, @args ) = @_;
my $pid = fork();
if ( not defined $pid ) {
die "Could not fork: $!";
}
elsif ( $pid == 0 ) {
$code->(@args);
exit 1;
}
else {
waitpid( $pid, 0 ); # parent
}
}
sub test_more_is_like_return_42 {
my ( $got, $expected, $name ) = @_;
ref($expected) eq 'Regexp' ? Test::More::like( $got, $expected, $name ) : Test::More::is( $got, $expected, $name );
return 42;
}
# use Test::Output; # rt 72976
# The Perl::Critic test failures will go away when this temp workaround goes away
sub tmp_stdout_like_rt_72976 {
my ( $func, $regex, $name ) = @_;
my $output = '';
{
unlink "tmp.$$.tmp";
no warnings 'once';
open OLDOUT, '>&STDOUT' or die "Could not dup STDOUT: $!"; ## no critic
close STDOUT;
open STDOUT, '>', "tmp.$$.tmp" or die "Could not redirect STDOUT: $!";
# \$output does not capture system()
# open STDOUT, '>', \$output or die "Could not redirect STDOUT: $!";
$func->();
open STDOUT, '>&OLDOUT' or die "Could not restore STDOUT: $!"; ## no critic
open my $fh, '<', "tmp.$$.tmp" or die "Could not open temp file: $!";
while ( my $line = <$fh> ) {
$output .= $line;
}
close $fh;
unlink "tmp.$$.tmp";
}
# use Data::Dumper;diag(Dumper([$output,$regex,$name]));
Test::More::like( $output, $regex, $name );
}
1;
__END__
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2011 cPanel, Inc. C<< <copyright@cpanel.net>> >>. All rights reserved.
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself, either Perl version 5.10.1 or, at your option,
any later version of Perl 5 you may have available.
|
