wvtestrunner.pl

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