4 # Copyright (C) 2007-2009 Versabanq Innovations Inc. and contributors.
5 # Copyright (C) 2015 Rob Browning <rlb@defaultvalue.org>
6 # Licensed under the GNU Library General Public License, version 2.
7 # See the included file named LICENSE for license information.
11 use Getopt::Long qw(GetOptionsFromArray :config no_ignore_case bundling);
13 use Time::HiRes qw(time);
15 my $per_test_warn_time = 100000; # upstream was 500
16 my $per_test_bad_time = 100000; # upstream was 1000
17 my $overall_test_warn_time = 100000; # upstream was 2000
18 my $overall_test_bad_time = 100000; # upstream was 5000
21 my $istty = -t STDOUT;
29 print "\n" . join("\n", @log) . "\n";
32 print STDERR "\n! Killed by signal FAILED\n";
34 ($pid > 0) || die("pid is '$pid'?!\n");
36 local $SIG{CHLD} = sub { }; # this will wake us from sleep() faster
51 my $pass = ($result eq "ok");
54 my $colour = $pass ? "\e[32;1m" : "\e[31;1m";
55 return "$colour$result\e[0m";
63 my ($floatsec, $warntime, $badtime) = @_;
64 my $ms = int($floatsec * 1000);
65 my $str = sprintf("%d.%03ds", $ms/1000, $ms % 1000);
67 if ($istty && $ms > $badtime) {
68 return "\e[31;1m$str\e[0m";
69 } elsif ($istty && $ms > $warntime) {
70 return "\e[33;1m$str\e[0m";
78 my ($name, $result) = @_;
79 return sprintf("! %-65s %s", $name, colourize($result));
89 mstime($stop - $start, $per_test_warn_time, $per_test_bad_time),
96 # dup_msgs should be true when "watching". In that case all top
97 # level wvtest protocol messages should be duplicated to stderr so
98 # that they can be safely captured for report to process later.
101 GetOptionsFromArray(\@ARGV, 'counts!', \$show_counts)
103 pod2usage('$0: no command specified') if (@ARGV < 1);
109 my $msg = "Testing \"all\" in @ARGV:\n";
111 print STDERR $msg if $dup_msgs;
114 $pid = open(my $fh, "-|");
118 open STDERR, '>&STDOUT' or die("Can't dup stdout: $!\n");
120 exit 126; # just in case
124 my $allstart = time();
125 local $SIG{INT} = sub { bigkill($pid); };
126 local $SIG{TERM} = sub { bigkill($pid); };
127 local $SIG{ALRM} = sub {
128 print STDERR resultline('Alarm timed out! No test results for too long.\n',
133 my ($gpasses, $gfails) = (0,0);
139 if (/^\s*Testing "(.*)" in (.*):\s*$/)
142 my ($sect, $file) = ($1, $2);
146 printf("! %s %s: ", $file, $sect);
150 elsif (/^!\s*(.*?)\s+(\S+)\s*$/)
154 my ($name, $result) = ($1, $2);
155 my $pass = ($result eq "ok");
158 printf("\n! Startup: ");
162 push @log, resultline($name, $result);
167 print "\n" . join("\n", @log) . "\n";
183 my $newpid = waitpid($pid, 0);
184 if ($newpid != $pid) {
185 die("waitpid returned '$newpid', expected '$pid'\n");
189 my $ret = ($code >> 8);
191 # return death-from-signal exits as >128. This is what bash does if you ran
192 # the program directly.
193 if ($code && !$ret) { $ret = $code | 128; }
196 print "\n" . join("\n", @log) . "\n";
200 my $msg = resultline("Program returned non-zero exit code ($ret)",
203 print STDERR "$msg\n" if $dup_msgs;
208 my $gtotal = $gpasses + $gfails;
209 my $msg = sprintf("WvTest: %d test%s, %d failure%s\n",
210 $gtotal, $gtotal == 1 ? "" : "s", $gfails,
211 $gfails == 1 ? "" : "s");
213 print STDERR $msg if $dup_msgs;
216 my $msg = sprintf("WvTest: result code $ret, total time %s\n",
217 mstime(time() - $allstart,
218 $overall_test_warn_time,
219 $overall_test_bad_time));
221 print STDERR $msg if $dup_msgs;
223 return ($ret ? $ret : ($gfails ? 125 : 0));
228 my ($gpasses, $gfails) = (0,0);
232 open($fh, '<:crlf', $f) or die "Unable to open $f: $!";
238 if (/^\s*Testing "(.*)" in (.*):\s*$/) {
241 elsif (/^!\s*(.*?)\s+(\S+)\s*$/) {
242 my ($name, $result) = ($1, $2);
243 my $pass = ($result eq "ok");
244 push @log, resultline($name, $result);
248 print "\n" . join("\n", @log) . "\n";
261 my $gtotal = $gpasses + $gfails;
262 printf("\nWvTest: %d test%s, %d failure%s\n",
263 $gtotal, $gtotal == 1 ? "" : "s",
264 $gfails, $gfails == 1 ? "" : "s");
265 return ($gfails ? 125 : 0);
268 my ($show_help, $show_manual);
269 Getopt::Long::Configure('no_permute');
270 GetOptionsFromArray(\@ARGV,
271 'help|?' => \$show_help,
272 'man' => \$show_manual) or pod2usage();
273 Getopt::Long::Configure('permute');
274 pod2usage(-verbose => 1, -exitval => 0) if $show_help;
275 pod2usage(-verbose => 2, -exitval => 0) if $show_manual;
276 pod2usage(-msg => "$0: no action specified", -verbose => 1) if (@ARGV < 1);
278 my $action = $ARGV[0];
280 if ($action eq 'run') { exit run(0); }
281 elsif ($action eq 'watch') { run(1); }
282 elsif ($action eq 'report') { exit report(); }
283 else { pod2usage(-msg => "$0: invalid action $action", -verbose => 1); }
289 wvtest - the dumbest cross-platform test framework that could possibly work
293 wvtest [GLOBAL...] run [RUN_OPT...] [--] command [arg...]
294 wvtest [GLOBAL...] watch [RUN_OPT...] [--] command [arg...]
295 wvtest [GLOBAL...] report [logfile...]
298 --help, -? display brief help message and exit
299 --man display full documentation
301 --[no-]counts [don't] show success/failure counts
305 B<wvtest run some-tests> will run some-tests and report on the result.
306 This should work fine as long as some-tests doesn't run any sub-tests
309 If you'd like to run your tests in parallel, use B<watch> and
310 B<report> as described in the EXAMPLES below.
314 # Fine if ./tests doesn't produce any output in parallel.
317 # Use watch and report for parallel tests. Note that watch's stderr will
318 # include copies of any top level messages - reporting non-zero
319 # test command exits, etc., and so must be included in the report arguments.
320 wvtest watch --no-counts \
321 "sh -c '(test-1 2>&1 | tee test-1.log)& (test-2 2>&1 | tee test-2.log)&'" \
323 wvtest report test-1.log test-2.log test-3.log