Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 187 lines (151 sloc) 3.63 kB
01d3e50 @apenwarr Import wvtestrun and wvtest.py from the wvtest.git project.
authored
1 #!/usr/bin/perl -w
2 #
3 # WvTest:
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.
7 #
8 use strict;
9 use Time::HiRes qw(time);
10
11 # always flush
12 $| = 1;
13
14 if (@ARGV < 1) {
15 print STDERR "Usage: $0 <command line...>\n";
16 exit 127;
17 }
18
19 print STDERR "Testing \"all\" in @ARGV:\n";
20
21 my $pid = open(my $fh, "-|");
22 if (!$pid) {
23 # child
24 setpgrp();
25 open STDERR, '>&STDOUT' or die("Can't dup stdout: $!\n");
26 exec(@ARGV);
27 exit 126; # just in case
28 }
29
30 my $istty = -t STDOUT;
31 my @log = ();
32 my ($gpasses, $gfails) = (0,0);
33
34 sub bigkill($)
35 {
36 my $pid = shift;
37
38 if (@log) {
39 print "\n" . join("\n", @log) . "\n";
40 }
41
42 print STDERR "\n! Killed by signal FAILED\n";
43
44 ($pid > 0) || die("pid is '$pid'?!\n");
45
46 local $SIG{CHLD} = sub { }; # this will wake us from sleep() faster
47 kill 15, $pid;
48 sleep(2);
49
50 if ($pid > 1) {
51 kill 9, -$pid;
52 }
53 kill 9, $pid;
54
55 exit(125);
56 }
57
58 # parent
59 local $SIG{INT} = sub { bigkill($pid); };
60 local $SIG{TERM} = sub { bigkill($pid); };
61 local $SIG{ALRM} = sub {
62 print STDERR "Alarm timed out! No test results for too long.\n";
63 bigkill($pid);
64 };
65
66 sub colourize($)
67 {
68 my $result = shift;
69 my $pass = ($result eq "ok");
70
71 if ($istty) {
72 my $colour = $pass ? "\e[32;1m" : "\e[31;1m";
73 return "$colour$result\e[0m";
74 } else {
75 return $result;
76 }
77 }
78
79 sub mstime($$$)
80 {
81 my ($floatsec, $warntime, $badtime) = @_;
82 my $ms = int($floatsec * 1000);
83 my $str = sprintf("%d.%03ds", $ms/1000, $ms % 1000);
84
85 if ($istty && $ms > $badtime) {
86 return "\e[31;1m$str\e[0m";
87 } elsif ($istty && $ms > $warntime) {
88 return "\e[33;1m$str\e[0m";
89 } else {
90 return "$str";
91 }
92 }
93
94 sub resultline($$)
95 {
96 my ($name, $result) = @_;
97 return sprintf("! %-65s %s", $name, colourize($result));
98 }
99
100 my $allstart = time();
101 my ($start, $stop);
102
103 sub endsect()
104 {
105 $stop = time();
106 if ($start) {
107 printf " %s %s\n", mstime($stop - $start, 500, 1000), colourize("ok");
108 }
109 }
110
111 while (<$fh>)
112 {
113 chomp;
114 s/\r//g;
115
116 if (/^\s*Testing "(.*)" in (.*):\s*$/)
117 {
118 alarm(120);
119 my ($sect, $file) = ($1, $2);
120
121 endsect();
122
123 printf("! %s %s: ", $file, $sect);
124 @log = ();
125 $start = $stop;
126 }
127 elsif (/^!\s*(.*?)\s+(\S+)\s*$/)
128 {
129 alarm(120);
130
131 my ($name, $result) = ($1, $2);
132 my $pass = ($result eq "ok");
133
134 if (!$start) {
135 printf("\n! Startup: ");
136 $start = time();
137 }
138
139 push @log, resultline($name, $result);
140
141 if (!$pass) {
142 $gfails++;
143 if (@log) {
144 print "\n" . join("\n", @log) . "\n";
145 @log = ();
146 }
147 } else {
148 $gpasses++;
149 print ".";
150 }
151 }
152 else
153 {
154 push @log, $_;
155 }
156 }
157
158 endsect();
159
160 my $newpid = waitpid($pid, 0);
161 if ($newpid != $pid) {
162 die("waitpid returned '$newpid', expected '$pid'\n");
163 }
164
165 my $code = $?;
166 my $ret = ($code >> 8);
167
168 # return death-from-signal exits as >128. This is what bash does if you ran
169 # the program directly.
170 if ($code && !$ret) { $ret = $code | 128; }
171
172 if ($ret && @log) {
173 print "\n" . join("\n", @log) . "\n";
174 }
175
176 if ($code != 0) {
177 print resultline("Program returned non-zero exit code ($ret)", "FAILED");
178 }
179
180 my $gtotal = $gpasses+$gfails;
181 printf("\nWvTest: %d test%s, %d failure%s, total time %s.\n",
182 $gtotal, $gtotal==1 ? "" : "s",
183 $gfails, $gfails==1 ? "" : "s",
184 mstime(time() - $allstart, 2000, 5000));
185 print STDERR "\nWvTest result code: $ret\n";
186 exit( $ret ? $ret : ($gfails ? 125 : 0) );
Something went wrong with that request. Please try again.