4 # Copyright (C)2007-2009 Versabanq Innovations Inc. and contributors.
5 # Licensed under the GNU Library General Public License, version 2.
6 # See the included file named LICENSE for license information.
9 use Time::HiRes qw(time);
15 print STDERR "Usage: $0 <command line...>\n";
19 print STDERR "Testing \"all\" in @ARGV:\n";
21 my $pid = open(my $fh, "-|");
25 open STDERR, '>&STDOUT' or die("Can't dup stdout: $!\n");
27 exit 126; # just in case
30 my $istty = -t STDOUT && $ENV{'TERM'} ne "dumb";
31 my $columns = `tput cols` if ($istty);
34 my ($gpasses, $gfails) = (0,0);
42 print "\n" . join("\n", @log) . "\n";
45 print STDERR "\n! Killed by signal FAILED\n";
47 ($pid > 0) || die("pid is '$pid'?!\n");
49 local $SIG{CHLD} = sub { }; # this will wake us from sleep() faster
62 local $SIG{INT} = sub { bigkill($pid); };
63 local $SIG{TERM} = sub { bigkill($pid); };
64 local $SIG{ALRM} = sub {
65 print STDERR "Alarm timed out! No test results for too long.\n";
71 my ($column, $result) = @_;
72 my $pass = ($result eq "ok");
75 my $dots = $columns - 15 - $column%$columns;
76 $dots += $columns if ($dots < 0);
77 my $leader = "."x$dots;
78 my $colour = $pass ? "\e[32;1m" : "\e[31;1m";
79 return "$colour$leader $result\e[0m";
87 my ($floatsec, $warntime, $badtime) = @_;
88 my $ms = int($floatsec * 1000);
89 my $str = sprintf("%d.%03ds", $ms/1000, $ms % 1000);
91 if ($istty && $ms > $badtime) {
92 return ("\e[31;1m$str\e[0m", length($str));
93 } elsif ($istty && $ms > $warntime) {
94 return ("\e[33;1m$str\e[0m", length($str));
96 return ("$str", length($str));
102 my ($name, $result) = @_;
103 return sprintf("! %s %s", $name, colourize(2+length($name)+1, $result));
106 my $allstart = time();
113 my ($time, $timelength) = mstime($stop - $start, 500, 1000);
114 printf " %s %s\n", $time, colourize($column + 2 + $timelength, "ok");
123 if (/^\s*Testing "(.*)" in (.*):\s*$/)
126 my ($sect, $file) = ($1, $2);
130 my $msg = sprintf("! %s %s: ", $file, $sect);
132 $column = length($msg);
137 elsif (/^!\s*(.*?)\s+(\S+)\s*$/)
141 my ($name, $result) = ($1, $2);
142 my $pass = ($result eq "ok");
145 printf("\n! Startup: ");
150 push @log, resultline($name, $result);
155 print "\n" . join("\n", @log) . "\n";
172 my $newpid = waitpid($pid, 0);
173 if ($newpid != $pid) {
174 die("waitpid returned '$newpid', expected '$pid'\n");
178 my $ret = ($code >> 8);
180 # return death-from-signal exits as >128. This is what bash does if you ran
181 # the program directly.
182 if ($code && !$ret) { $ret = $code | 128; }
185 print "\n" . join("\n", @log) . "\n";
189 print resultline("Program returned non-zero exit code ($ret)", "FAILED");
192 my $gtotal = $gpasses+$gfails;
193 printf("\nWvTest: %d test%s, %d failure%s, total time %s.\n",
194 $gtotal, $gtotal==1 ? "" : "s",
195 $gfails, $gfails==1 ? "" : "s",
196 mstime(time() - $allstart, 2000, 5000));
197 print STDERR "\nWvTest result code: $ret\n";
198 exit( $ret ? $ret : ($gfails ? 125 : 0) );