wvtestrun

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