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");
90 GetOptionsFromArray(\@ARGV, 'counts!', \$show_counts)
92 pod2usage('$0: no command specified') if (@ARGV < 1);
97 print STDERR "Testing \"all\" in @ARGV:\n";
99 $pid = open(my $fh, "-|");
103 open STDERR, '>&STDOUT' or die("Can't dup stdout: $!\n");
105 exit 126; # just in case
109 my $allstart = time();
110 local $SIG{INT} = sub { bigkill($pid); };
111 local $SIG{TERM} = sub { bigkill($pid); };
112 local $SIG{ALRM} = sub {
113 print STDERR "Alarm timed out! No test results for too long.\n";
117 my ($gpasses, $gfails) = (0,0);
123 if (/^\s*Testing "(.*)" in (.*):\s*$/)
126 my ($sect, $file) = ($1, $2);
130 printf("! %s %s: ", $file, $sect);
134 elsif (/^!\s*(.*?)\s+(\S+)\s*$/)
138 my ($name, $result) = ($1, $2);
139 my $pass = ($result eq "ok");
142 printf("\n! Startup: ");
146 push @log, resultline($name, $result);
151 print "\n" . join("\n", @log) . "\n";
167 my $newpid = waitpid($pid, 0);
168 if ($newpid != $pid) {
169 die("waitpid returned '$newpid', expected '$pid'\n");
173 my $ret = ($code >> 8);
175 # return death-from-signal exits as >128. This is what bash does if you ran
176 # the program directly.
177 if ($code && !$ret) { $ret = $code | 128; }
180 print "\n" . join("\n", @log) . "\n";
184 print resultline("Program returned non-zero exit code ($ret)", "FAILED");
189 my $gtotal = $gpasses + $gfails;
190 printf("WvTest: %d test%s, %d failure%s\n",
191 $gtotal, $gtotal==1 ? "" : "s",
192 $gfails, $gfails==1 ? "" : "s");
194 printf("WvTest: result code $ret, total time %s\n",
195 mstime(time() - $allstart, 2000, 5000));
196 return ($ret ? $ret : ($gfails ? 125 : 0));
201 my ($gpasses, $gfails) = (0,0);
205 open($fh, '<:crlf', $f) or die "Unable to open $f: $!";
211 if (/^\s*Testing "(.*)" in (.*):\s*$/) {
214 elsif (/^!\s*(.*?)\s+(\S+)\s*$/) {
215 my ($name, $result) = ($1, $2);
216 my $pass = ($result eq "ok");
217 push @log, resultline($name, $result);
221 print "\n" . join("\n", @log) . "\n";
234 my $gtotal = $gpasses + $gfails;
235 printf("\nWvTest: %d test%s, %d failure%s\n",
236 $gtotal, $gtotal == 1 ? "" : "s",
237 $gfails, $gfails == 1 ? "" : "s");
238 return ($gfails ? 125 : 0);
241 my ($show_help, $show_manual);
242 Getopt::Long::Configure('no_permute');
243 GetOptionsFromArray(\@ARGV,
244 'help|?' => \$show_help,
245 'man' => \$show_manual) or pod2usage();
246 Getopt::Long::Configure('permute');
247 pod2usage(-verbose => 1, -exitval => 0) if $show_help;
248 pod2usage(-verbose => 2, -exitval => 0) if $show_manual;
249 pod2usage(-msg => "$0: no action specified", -verbose => 1) if (@ARGV < 1);
251 my $action = $ARGV[0];
253 if ($action eq 'run') { exit run(); }
254 elsif ($action eq 'watch') { run(); }
255 elsif ($action eq 'report') { exit report(); }
256 else { pod2usage(-msg => "$0: invalid action $action", -verbose => 1); }
262 wvtest - the dumbest cross-platform test framework that could possibly work
266 wvtest [GLOBAL...] run [RUN_OPT...] [--] command [arg...]
267 wvtest [GLOBAL...] watch [RUN_OPT...] [--] command [arg...]
268 wvtest [GLOBAL...] report [logfile...]
271 --help, -? display brief help message and exit
272 --man display full documentation
274 --[no-]counts [don't] show success/failure counts
278 B<wvtest run some-tests> will run some-tests and report on the result.
279 This should work fine as long as some-tests doesn't run any sub-tests
282 If you'd like to run your tests in parallel, use B<watch> and
283 B<report> as described in the EXAMPLES below.
287 # Fine if ./tests doesn't produce any output in parallel.
290 # Use watch and report for parallel tests.
291 wvtest watch --no-counts \
292 sh -c '(test-1 2>&1 | tee test-1.log)& (test-2 2>&1 | tee test-2.log)&'
293 wvtest report test-1.log test-2.log