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
|
package Test::Execute;
use 5.16.0;
use strict;
use warnings FATAL => 'all';
use Test::More;
use Capture::Tiny qw/ capture_merged /;
use Exporter 'import';
use Carp 'croak';
use Scalar::Util 'reftype';
our $VERSION = '0.001';
our @EXPORT = qw(
run
script
$path
);
our $path = "";
sub run {
my %args = (
exit => 0,
cmd => [],
input => undef,
test => 1,
expected => undef,
name => undef,
@_
);
my @cmd = @{ $args{cmd} };
return unless @cmd; # no command to run
my ($exit, $input, $test, $expected, $name, $note) =
@args{qw/ exit input test expected name note /};
my ($output, $return) = capture_merged {
my $ret;
if (defined $input) {
my $pid = open (my $fh, '|-', @cmd);
last unless $pid;
print { $fh } $input or last;
close $fh;
$ret = $? >> 8;
} else {
$ret = system(@cmd) && $? >> 8;
}
};
if ($note) {
note sprintf "Exit value: %s", $return // '<undef>';
note "Output: $output";
}
if (not $test) {
if (defined $expected and ref $expected eq 'Regexp') {
return $output =~ $expected;
} elsif (defined $expected and ref $expected eq 'CODE') {
return $expected->($output);
}
return $return;
}
$name //= "Testing run of @cmd";
local $Test::Builder::Level = $Test::Builder::Level + 2;
subtest $name => sub {
plan tests => 2;
# 1: Test exit value
if (not defined $exit) {
SKIP: { skip "Expected exit value undefined", 1 }
} else {
is ($return, $exit, "$name - exit value");
}
# 2: Test output
if (not defined $expected) {
SKIP: { skip "Expected output undefined", 1 }
} elsif (ref $expected eq 'Regexp') {
like ($output, $expected, "$name - output");
} elsif (ref $expected eq 'CODE') {
ok ($expected->($output), "$name - output");
} else {
is ($output, $expected, "$name - output");
}
};
}
sub script {
my @cmd;
while (@_ and not defined reftype($_[0])) {
my $arg = shift @_;
push @cmd, $arg;
}
my %args;
if (@_ and reftype($_[0]) eq 'HASH') { %args = %{ $_[0] }; }
elsif (@_) { croak "Unknown argument passed: $_[0]"; }
if (exists $args{cmd} and @cmd) { croak "More than one command passed"; }
if (exists $args{cmd}) { @cmd = @{ $args{cmd} }; }
my $cmd = shift @cmd;
if (not defined $cmd) { croak "No command passed"; }
$args{name} //= "Testing script run of $cmd @cmd";
my @lib = map { "-I$_" } @INC;
@cmd = ($^X, @lib, "$path$cmd", @cmd);
$args{cmd} = \@cmd;
return run(%args);
}
1;
|
