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);
16 my $istty = -t STDOUT;
24 print "\n" . join("\n", @log) . "\n";
27 print STDERR "\n! Killed by signal FAILED\n";
29 ($pid > 0) || die("pid is '$pid'?!\n");
31 local $SIG{CHLD} = sub { }; # this will wake us from sleep() faster
46 my $pass = ($result eq "ok");
49 my $colour = $pass ? "\e[32;1m" : "\e[31;1m";
50 return "$colour$result\e[0m";
58 my ($floatsec, $warntime, $badtime) = @_;
59 my $ms = int($floatsec * 1000);
60 my $str = sprintf("%d.%03ds", $ms/1000, $ms % 1000);
62 if ($istty && $ms > $badtime) {
63 return "\e[31;1m$str\e[0m";
64 } elsif ($istty && $ms > $warntime) {
65 return "\e[33;1m$str\e[0m";
73 my ($name, $result) = @_;
74 return sprintf("! %-65s %s", $name, colourize($result));
83 printf " %s %s\n", mstime($stop - $start, 500, 1000), colourize("ok");
89 # dup_msgs should be true when "watching". In that case all top
90 # level wvtest protocol messages should be duplicated to stderr so
91 # that they can be safely captured for report to process later.
94 GetOptionsFromArray(\@ARGV, 'counts!', \$show_counts)
96 pod2usage('$0: no command specified') if (@ARGV < 1);
102 my $msg = "Testing \"all\" in @ARGV:\n";
104 print STDERR $msg if $dup_msgs;
107 $pid = open(my $fh, "-|");
111 open STDERR, '>&STDOUT' or die("Can't dup stdout: $!\n");
113 exit 126; # just in case
117 my $allstart = time();
118 local $SIG{INT} = sub { bigkill($pid); };
119 local $SIG{TERM} = sub { bigkill($pid); };
120 local $SIG{ALRM} = sub {
121 print STDERR resultline('Alarm timed out! No test results for too long.\n',
126 my ($gpasses, $gfails) = (0,0);
132 if (/^\s*Testing "(.*)" in (.*):\s*$/)
135 my ($sect, $file) = ($1, $2);
139 printf("! %s %s: ", $file, $sect);
143 elsif (/^!\s*(.*?)\s+(\S+)\s*$/)
147 my ($name, $result) = ($1, $2);
148 my $pass = ($result eq "ok");
151 printf("\n! Startup: ");
155 push @log, resultline($name, $result);
160 print "\n" . join("\n", @log) . "\n";
176 my $newpid = waitpid($pid, 0);
177 if ($newpid != $pid) {
178 die("waitpid returned '$newpid', expected '$pid'\n");
182 my $ret = ($code >> 8);
184 # return death-from-signal exits as >128. This is what bash does if you ran
185 # the program directly.
186 if ($code && !$ret) { $ret = $code | 128; }
189 print "\n" . join("\n", @log) . "\n";
193 my $msg = resultline("Program returned non-zero exit code ($ret)",
196 print STDERR "$msg\n" if $dup_msgs;
201 my $gtotal = $gpasses + $gfails;
202 my $msg = sprintf("WvTest: %d test%s, %d failure%s\n",
203 $gtotal, $gtotal == 1 ? "" : "s", $gfails,
204 $gfails == 1 ? "" : "s");
206 print STDERR $msg if $dup_msgs;
209 my $msg = sprintf("WvTest: result code $ret, total time %s\n",
210 mstime(time() - $allstart, 2000, 5000));
212 print STDERR $msg if $dup_msgs;
214 return ($ret ? $ret : ($gfails ? 125 : 0));
219 my ($gpasses, $gfails) = (0,0);
223 open($fh, '<:crlf', $f) or die "Unable to open $f: $!";
229 if (/^\s*Testing "(.*)" in (.*):\s*$/) {
232 elsif (/^!\s*(.*?)\s+(\S+)\s*$/) {
233 my ($name, $result) = ($1, $2);
234 my $pass = ($result eq "ok");
235 push @log, resultline($name, $result);
239 print "\n" . join("\n", @log) . "\n";
252 my $gtotal = $gpasses + $gfails;
253 printf("\nWvTest: %d test%s, %d failure%s\n",
254 $gtotal, $gtotal == 1 ? "" : "s",
255 $gfails, $gfails == 1 ? "" : "s");
256 return ($gfails ? 125 : 0);
259 my ($show_help, $show_manual);
260 Getopt::Long::Configure('no_permute');
261 GetOptionsFromArray(\@ARGV,
262 'help|?' => \$show_help,
263 'man' => \$show_manual) or pod2usage();
264 Getopt::Long::Configure('permute');
265 pod2usage(-verbose => 1, -exitval => 0) if $show_help;
266 pod2usage(-verbose => 2, -exitval => 0) if $show_manual;
267 pod2usage(-msg => "$0: no action specified", -verbose => 1) if (@ARGV < 1);
269 my $action = $ARGV[0];
271 if ($action eq 'run') { exit run(0); }
272 elsif ($action eq 'watch') { run(1); }
273 elsif ($action eq 'report') { exit report(); }
274 else { pod2usage(-msg => "$0: invalid action $action", -verbose => 1); }
280 wvtest - the dumbest cross-platform test framework that could possibly work
284 wvtest [GLOBAL...] run [RUN_OPT...] [--] command [arg...]
285 wvtest [GLOBAL...] watch [RUN_OPT...] [--] command [arg...]
286 wvtest [GLOBAL...] report [logfile...]
289 --help, -? display brief help message and exit
290 --man display full documentation
292 --[no-]counts [don't] show success/failure counts
296 B<wvtest run some-tests> will run some-tests and report on the result.
297 This should work fine as long as some-tests doesn't run any sub-tests
300 If you'd like to run your tests in parallel, use B<watch> and
301 B<report> as described in the EXAMPLES below.
305 # Fine if ./tests doesn't produce any output in parallel.
308 # Use watch and report for parallel tests. Note that watch's stderr will
309 # include copies of any top level messages - reporting non-zero
310 # test command exits, etc., and so must be included in the report arguments.
311 wvtest watch --no-counts \
312 "sh -c '(test-1 2>&1 | tee test-1.log)& (test-2 2>&1 | tee test-2.log)&'" \
314 wvtest report test-1.log test-2.log test-3.log