]> rtime.felk.cvut.cz Git - wvtest.git/blob - wvtestrunner.pl
Replaced wvtesthelper/meter/colour scripts with an all-new wvtestrunner.pl.
[wvtest.git] / wvtestrunner.pl
1 #!/usr/bin/perl -w
2 use strict;
3
4 # always flush
5 $| = 1;
6
7 if (@ARGV < 1) {
8     print STDERR "Usage: $0 <command line...>\n";
9     exit 127;
10 }
11
12 print STDERR "Testing \"all\" in @ARGV:\n";
13
14 my $pid = open(my $fh, "-|");
15 if (!$pid) {
16     # child
17     setpgrp();
18     open STDERR, '>&STDOUT' or die("Can't dup stdout: $!\n");
19     exec(@ARGV);
20     exit 126; # just in case
21 }
22
23 my $istty = -t STDOUT;
24 my @log = ();
25 my ($gpasses, $gfails) = (0,0);
26
27 sub bigkill($)
28 {
29     my $pid = shift;
30     
31     if (@log) {
32         print "\n" . join("\n", @log) . "\n";
33     }
34     
35     print STDERR "Killed by signal.\n";
36
37     ($pid > 0) || die("pid is '$pid'?!\n");
38
39     local $SIG{CHLD} = sub { }; # this will wake us from sleep() faster
40     kill 15, $pid;
41     sleep(2);
42     
43     if ($pid > 1) {
44         kill 9, -$pid;
45     }
46     kill 9, $pid;
47     
48     exit(125);
49 }
50
51 # parent
52 local $SIG{INT} = sub { bigkill($pid); };
53 local $SIG{TERM} = sub { bikill($pid); };
54
55 sub colourize($)
56 {
57     my $result = shift;
58     my $pass = ($result eq "ok");
59     
60     if ($istty) {
61         my $colour = $pass ? "\e[32;1m" : "\e[31;1m";
62         return "$colour$result\e[0m";
63     } else {
64         return $result;
65     }
66 }
67
68 sub resultline($$)
69 {
70     my ($name, $result) = @_;
71     return sprintf("! %-65s %s", $name, colourize($result));
72 }
73
74 my $insection = 0;
75
76 while (<$fh>)
77 {
78     chomp;
79     
80     if (/^\s*Testing "(.*)" in (.*):\s*$/)
81     {
82         my ($sect, $file) = ($1, $2);
83         
84         if ($insection) {
85             printf " %s\n", colourize("ok");
86         }
87         
88         printf("! %s  %s: ", $file, $sect);
89         @log = ();
90         $insection = 1;
91     }
92     elsif (/^!\s*(.*?)\s+(\S+)\s*$/)
93     {
94         my ($name, $result) = ($1, $2);
95         my $pass = ($result eq "ok");
96         
97         if (!$insection) {
98             printf("\n! Startup: ");
99         }
100         $insection++;
101         
102         push @log, resultline($name, $result);
103         
104         if (!$pass) {
105             $gfails++;
106             if (@log) {
107                 print "\n" . join("\n", @log) . "\n";
108                 @log = ();
109             }
110         } else {
111             $gpasses++;
112             print ".";
113         }
114     }
115     else
116     {
117         push @log, $_;
118     }
119 }
120
121 if ($insection) {
122     printf " %s\n", colourize("ok");
123 }
124
125 my $newpid = waitpid($pid, 0);
126 if ($newpid != $pid) {
127     die("waitpid returned '$newpid', expected '$pid'\n");
128 }
129
130 my $code = $?;
131 my $ret = ($code >> 8);
132
133 if ($ret && @log) {
134     print "\n" . join("\n", @log) . "\n";
135 }
136
137
138 my $gtotal = $gpasses+$gfails;
139 printf("\nWvTest: %d test%s, %d failure%s.\n",
140     $gtotal, $gtotal==1 ? "" : "s",
141     $gfails, $gfails==1 ? "" : "s");
142 print STDERR "\nWvTest result code: $ret\n";
143 exit( $ret ? $ret : ($gfails ? 125 : 0) );