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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
package T;
require 5.004;
use strict;
use vars qw($VERSION @ISA @EXPORT);
use FileHandle;
use File::Compare qw(compare);
@ISA = qw(Exporter);
$VERSION = '0.5';
@EXPORT = qw (run_tests);
my @Types = qw (IN OUT ERR EXIT);
my %Types = map {$_ => 1} @Types;
my %Zero_one_type = map {$_ => 1} qw (OUT ERR EXIT);
my $Global_count = 1;
sub _create_file ($$$$$)
{
my ($program_name, $test_name, $type, $file_name, $data) = @_;
my $file;
if (defined $file_name)
{
$file = $file_name;
}
else
{
$file = "$test_name-$$.$Global_count";
++$Global_count;
}
# The test spec gave a string.
# Write it to a temp file and return tempfile name.
#warn "writing $type `$data' to $file\n";
my $fh = new FileHandle "> $file";
die "$program_name: $file: $!\n" if ! $fh;
print $fh $data;
$fh->close || die "$program_name: $file: $!\n";
return $file;
}
# FIXME: having to include $program_name here is an expedient kludge.
# Library code doesn't `die'.
sub run_tests ($$$$$)
{
my ($program_name, $prog, $t_spec, $save_temps, $verbose) = @_;
# Warn about empty t_spec.
# FIXME
# Remove all temp files upon interrupt.
# FIXME
# Verify that test names are distinct.
my $found_duplicate = 0;
my %seen;
my $t;
foreach $t (@$t_spec)
{
my $test_name = $t->[0];
if ($seen{$test_name})
{
warn "$program_name: $test_name: duplicate test name\n";
$found_duplicate = 1;
}
$seen{$test_name} = 1;
}
return 1 if $found_duplicate;
# FIXME check exit status
system ($prog, '--version');
my @junk_files;
my $fail = 0;
foreach $t (@$t_spec)
{
my $test_name = shift @$t;
my $expect = {};
$Global_count = 1;
my @args;
my $io_spec;
my %seen_type;
foreach $io_spec (@$t)
{
if (!ref $io_spec)
{
push @args, $io_spec;
next;
}
die "$program_name: $test_name: invalid test spec\n"
if ref $io_spec ne 'HASH';
my $n = keys %$io_spec;
die "$program_name: $test_name: spec has $n elements --"
. " expected 1\n"
if $n != 1;
my ($type, $val) = each %$io_spec;
die "$program_name: $test_name: invalid key `$type' in test spec\n"
if ! $Types{$type};
# Make sure there's no more than one of OUT, ERR, EXIT.
die "$program_name: $test_name: more than one $type spec\n"
if $Zero_one_type{$type} and $seen_type{$type}++;
if ($type eq 'EXIT')
{
# FIXME: make sure $data is numeric
$expect->{EXIT} = $val;
next;
}
my $file_spec = $val;
my ($file_name, $contents);
if (!ref $file_spec)
{
($file_name, $contents) = (undef, $file_spec);
}
elsif (ref $file_spec eq 'HASH')
{
my $n = keys %$file_spec;
die "$program_name: $test_name: $type spec has $n elements --"
. " expected 1\n"
if $n != 1;
($file_name, $contents) = each %$file_spec;
}
else
{
die "$program_name: $test_name: invalid RHS in $type-spec\n"
}
my $is_junk_file = (! defined $file_name);
my $file = _create_file ($program_name, $test_name, $type,
$file_name, $contents);
if ($type eq 'IN')
{
push @args, $file
}
else
{
$expect->{$type} = $file;
}
if ($is_junk_file)
{
push @junk_files, $file
}
else
{
# FIXME: put $srcdir in here somewhere
warn "$program_name: $test_name: specified file `$file' does"
. " not exist\n"
if ! -f $file;
}
}
# Expect an exit status of zero if it's not specified.
$expect->{EXIT} ||= 0;
# Allow ERR to be omitted -- in that case, expect no error output.
my $eo;
foreach $eo (qw (ERR OUT))
{
if (!exists $expect->{$eo})
{
$expect->{$eo} = _create_file ($program_name, $test_name, $eo,
undef, '');
push @junk_files, $expect->{$eo};
}
}
# FIXME: Require at least one of OUT_DATA, OUT_FILE. Why?
warn "$test_name...\n";
my $t_out = "$test_name-out";
my $t_err = "$test_name-err";
push (@junk_files, $t_out, $t_err);
my @cmd = ($prog, @args, "> $t_out", "2> $t_err");
my $cmd_str = join (' ', @cmd);
warn "Running command: `$cmd_str'\n" if $verbose;
my $rc = 0xffff & system $cmd_str;
if ($rc == 0xff00)
{
warn "$program_name: test $test_name failed: command failed:\n"
. " `$cmd_str': $!\n";
$fail = 1;
next;
}
$rc >>= 8 if $rc > 0x80;
if ($expect->{EXIT} != $rc)
{
warn "$program_name: test $test_name failed: exit status mismatch:"
. " expected $expect->{EXIT}, got $rc\n";
$fail = 1;
next;
}
if (compare ($expect->{OUT}, $t_out))
{
warn "$program_name: stdout mismatch, comparing"
. " $expect->{OUT} and $t_out\n";
$fail = 1;
next;
}
if (compare ($expect->{ERR}, $t_err))
{
warn "$program_name: stderr mismatch, comparing"
. " $expect->{ERR} and $t_err\n";
$fail = 1;
next;
}
}
unlink @junk_files if ! $save_temps;
return $fail;
}
## package return
1;
|
