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
|
#!/usr/bin/env perl
# tap3 [DESC] - check output/error/status of a command against a specification
#
# A tiny variant of shelltestrunner (format v1), just takes one test
# case and outputs a TAP line.
#
# Input format:
#
# CMD
# <<<
# INPUT
# >>>
# OUTPUT
# >>> /OUTPUT REGEX/
# >>>2
# STDERR
# >>>2 /STDERR REGEX/
# >>>= STATUS
# >>>= !STATUS
#
# All but CMD are optional and can be put in any order,
# Regex variants can be repeated, all patterns must match.
# By default, STATUS is set to 0 and STDERR assumed empty.
#
# To the extent possible under law, the creator of this work has waived
# all copyright and related or neighboring rights to this work.
# http://creativecommons.org/publicdomain/zero/1.0/
use strict;
use warnings;
use Symbol 'gensym';
use IPC::Open3;
my $cmd = "";
my ($input, $output, @output_rx, $stderr, @stderr_rx, $status, $status_not);
my $ignored = "";
my $var = \$cmd;
while (<STDIN>) {
if (/^#!? /) { next; }
if (/^<<<$/) { $var = \$input; $input = ""; next; }
if (/^>>>$/) { $var = \$output; $output = ""; next; }
if (/^>>>2$/) { $var = \$stderr; $stderr = ""; next; }
if (/^>>>\s*\/(.*)\/$/) { push @output_rx, $1; next; }
if (/^>>>2\s*\/(.*)\/$/) { push @stderr_rx, $1; next; }
if (/^>>>=\s+(\d+)$/) { $var = \$ignored; $status = $1; next; }
if (/^>>>=\s+!(\d+)$/) { $var = \$ignored; $status_not = $1; next; }
$$var .= $_;
}
chomp($cmd);
die "No command to check given\n" if !$cmd;
my ($wtr, $rdr);
my $err = gensym;
my $pid = open3($wtr, $rdr, $err, "/bin/sh", "-c", $cmd);
my $desc = shift || $cmd;
$desc =~ s/\n.*//g;
print $wtr $input if (defined($input));
close $wtr;
my $real_output = do { local $/; <$rdr>; };
my $real_stderr = do { local $/; <$err>; };
waitpid($pid, 0);
my $real_status = $? >> 8;
my $r = 0;
sub not_ok {
print "not ok - $desc\n" if (!$r);
$r = 1;
$_[0] =~ s/^/# /mg;
print $_[0];
}
if (defined($output) && $real_output ne $output) {
not_ok("wrong output:\n$real_output");
}
for my $rx (@output_rx) {
if ($real_output !~ $rx) {
not_ok("output doesn't match /$rx/:\n$real_output\n");
}
}
if (defined($stderr) && $real_stderr ne $stderr) {
not_ok("wrong stderr:\n$real_stderr");
}
for my $rx (@stderr_rx) {
if ($real_stderr !~ $rx) {
not_ok("stderr doesn't match /$rx/:\n$real_stderr\n");
}
}
if (!defined($stderr) && !@stderr_rx &&
!defined($status) && !defined($status_not) &&
$real_stderr) {
not_ok("output to stderr:\n$real_stderr\n");
}
if (defined($status) && $real_status != $status) {
not_ok("wrong status: $real_status (expected $status)\n");
}
if (defined($status_not) && $real_status == $status_not) {
not_ok("wrong status: $real_status (expected anything else)\n");
}
if (!defined($status) && !defined($status_not) &&
!defined($stderr) && !@stderr_rx &&
$real_status != 0) {
not_ok("wrong status: $real_status (command failed)\n");
}
print "ok - $desc\n" if (!$r);
exit $r;
|
