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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
package Test::Util;
use Test::Util::Base -Base;
use Carp qw( confess );
use IPC::Run3;
#use Data::Dumper::Simple;
our @EXPORT = qw(
test_shell_command run_shell
split_arg join_list
process_pre process_post
process_found process_not_found
);
sub process_pre ($) {
my $block = shift;
my $code = $block->pre;
return if not $code;
{
package main;
eval $code;
}
confess "error in `pre' section: $@" if $@;
}
sub process_post ($) {
my $block = shift;
my $code = $block->post;
return if not $code;
{
package main;
eval $code;
}
confess "error in `post' section: $@" if $@;
}
sub process_found ($) {
my $block = shift;
my $buf = $block->found;
return if not $buf;
my @files = split /\s+/s, $buf;
for my $file (@files) {
Test::More::ok(
(-f $file),
"File $file should be found - ".$block->name
);
}
}
sub process_not_found ($) {
my $block = shift;
my $buf = $block->not_found;
return if not $buf;
my @files = split /\s+/s, $buf;
for my $file (@files) {
Test::More::ok(
!(-f $file),
"File $file should NOT be found - ".$block->name
);
}
}
sub compare ($$$) {
my ($got, $expected, $desc) = @_;
return if not defined $expected;
if ($desc =~ /\w+_like/) {
Test::More::like($got, qr/^$expected$/ms, $desc);
} else {
Test::More::is($got, $expected, $desc);
}
}
sub join_list (@) {
my @args = @_;
for (@args) {
if (ref $_ eq 'ARRAY') {
$_ = join('', @$_);
}
}
return wantarray ? @args : $args[0];
}
sub test_shell_command ($$@) {
my $block = shift;
my $cmd = shift;
my %filters = @_;
return if not defined $cmd;
my ($stdout, $stderr);
run3($cmd, \undef, \$stdout, \$stderr);
my $errcode = $?;
$errcode >>= 8;
my $success = ($errcode == 0);
my $errcode2 = $block->error_code;
if ($errcode2 and $errcode2 =~ /\d+/) {
$errcode2 = $&;
}
my $success2 = $block->success;
if ($success2 and $success2 =~ /\w+/) {
$success2 = lc($&);
}
my $name = $block->name;
while (my ($key, $val) = each %filters) {
#warn "$key $val";
if ($key eq 'stdout') {
$stdout = $val->($stdout);
} elsif ($key eq 'stderr') {
$stderr = $val->($stderr);
}
}
#warn "!!!~~~~ $stdout";
#warn "!!!~~~~ ", $block->stdout;
#use Test::Differences;
#eq_or_diff $stdout, $block->stdout;
compare $stdout, $block->stdout, "stdout - $name";
compare $stdout, $block->stdout_like, "stdout_like - $name";
compare $stderr, $block->stderr, "stderr - $name";
compare $stderr, $block->stderr_like, "stderr_like - $name";
compare $errcode, $errcode2, "error_code - $name";
compare (
$success ? 'true' : 'false',
$success2,
"success - $name",
);
if (not defined $block->stderr() and
not defined $block->stderr_like() and
$stderr) {
warn $stderr;
}
}
# returns ($error_code, $stdout, $stderr)
sub run_shell (@) {
my ($cmd, $verbose) = @_;
#$IPC::Cmd::USE_IPC_RUN = 1;
#confess Dumper($cmd);
my ($stdout, $stderr);
run3($cmd, \undef, \$stdout, \$stderr);
my $errcode = $?;
#warn "HERE!";
#warn "^^^ Output: $res[2][0]";
return ($errcode, $stdout, $stderr);
}
1;
|
