tests/wvtestrun

   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 && $ENV{'TERM'} ne "dumb";
  31 my $columns = `tput cols` if ($istty);
  32
  33 my @log = ();
  34 my ($gpasses, $gfails) = (0,0);
  35 my $column = 0;
  36
  37 sub bigkill($)
  38 {
  39     my $pid = shift;
  40
  41     if (@log) {
  42         print "\n" . join("\n", @log) . "\n";
  43     }
  44
  45     print STDERR "\n! Killed by signal    FAILED\n";
  46
  47     ($pid > 0) || die("pid is '$pid'?!\n");
  48
  49     local $SIG{CHLD} = sub { }; # this will wake us from sleep() faster
  50     kill 15, $pid;
  51     sleep(2);
  52
  53     if ($pid > 1) {
  54         kill 9, -$pid;
  55     }
  56     kill 9, $pid;
  57
  58     exit(125);
  59 }
  60
  61 # parent
  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";
  66     bigkill($pid);
  67 };
  68
  69 sub colourize($$)
  70 {
  71     my ($column, $result) = @_;
  72     my $pass = ($result eq "ok");
  73
  74     if ($istty) {
  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";
  80     } else {
  81         return $result;
  82     }
  83 }
  84
  85 sub mstime($$$)
  86 {
  87     my ($floatsec, $warntime, $badtime) = @_;
  88     my $ms = int($floatsec * 1000);
  89     my $str = sprintf("%d.%03ds", $ms/1000, $ms % 1000);
  90
  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));
  95     } else {
  96         return ("$str", length($str));
  97     }
  98 }
  99
 100 sub resultline($$)
 101 {
 102     my ($name, $result) = @_;
 103     return sprintf("! %s %s", $name, colourize(2+length($name)+1, $result));
 104 }
 105
 106 my $allstart = time();
 107 my ($start, $stop);
 108
 109 sub endsect()
 110 {
 111     $stop = time();
 112     if ($start) {
 113         my ($time, $timelength) = mstime($stop - $start, 500, 1000);
 114         printf " %s %s\n", $time, colourize($column + 2 + $timelength, "ok");
 115     }
 116 }
 117
 118 while (<$fh>)
 119 {
 120     chomp;
 121     s/\r//g;
 122
 123     if (/^\s*Testing "(.*)" in (.*):\s*$/)
 124     {
 125         alarm(120);
 126         my ($sect, $file) = ($1, $2);
 127
 128         endsect();
 129
 130         my $msg = sprintf("! %s  %s: ", $file, $sect);
 131         print $msg;
 132         $column = length($msg);
 133         @log = ();
 134         push @log, "-"x78;
 135         $start = $stop;
 136     }
 137     elsif (/^!\s*(.*?)\s+(\S+)\s*$/)
 138     {
 139         alarm(120);
 140
 141         my ($name, $result) = ($1, $2);
 142         my $pass = ($result eq "ok");
 143
 144         if (!$start) {
 145             printf("\n! Startup: ");
 146             $column = 11;
 147             $start = time();
 148         }
 149
 150         push @log, resultline($name, $result);
 151
 152         if (!$pass) {
 153             $gfails++;
 154             if (@log) {
 155                 print "\n" . join("\n", @log) . "\n";
 156                 @log = ();
 157             }
 158         } else {
 159             $gpasses++;
 160             print ".";
 161             $column++;
 162         }
 163     }
 164     else
 165     {
 166         push @log, $_;
 167     }
 168 }
 169
 170 endsect();
 171
 172 my $newpid = waitpid($pid, 0);
 173 if ($newpid != $pid) {
 174     die("waitpid returned '$newpid', expected '$pid'\n");
 175 }
 176
 177 my $code = $?;
 178 my $ret = ($code >> 8);
 179
 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; }
 183
 184 if ($ret && @log) {
 185     print "\n" . join("\n", @log) . "\n";
 186 }
 187
 188 if ($code != 0) {
 189     print resultline("Program returned non-zero exit code ($ret)", "FAILED");
 190 }
 191
 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) );