wvtestrun

   1 #!/usr/bin/env perl
   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 warnings;
  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;
  32 my @log = ();
  33 my ($gpasses, $gfails) = (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($)
  68 {
  69     my $result = shift;
  70     my $pass = ($result eq "ok");
  71
  72     if ($istty) {
  73         my $colour = $pass ? "\e[32;1m" : "\e[31;1m";
  74         return "$colour$result\e[0m";
  75     } else {
  76         return $result;
  77     }
  78 }
  79
  80 sub mstime($$$)
  81 {
  82     my ($floatsec, $warntime, $badtime) = @_;
  83     my $ms = int($floatsec * 1000);
  84     my $str = sprintf("%d.%03ds", $ms/1000, $ms % 1000);
  85
  86     if ($istty && $ms > $badtime) {
  87         return "\e[31;1m$str\e[0m";
  88     } elsif ($istty && $ms > $warntime) {
  89         return "\e[33;1m$str\e[0m";
  90     } else {
  91         return "$str";
  92     }
  93 }
  94
  95 sub resultline($$)
  96 {
  97     my ($name, $result) = @_;
  98     return sprintf("! %-65s %s", $name, colourize($result));
  99 }
 100
 101 my $allstart = time();
 102 my ($start, $stop);
 103
 104 sub endsect()
 105 {
 106     $stop = time();
 107     if ($start) {
 108         printf " %s %s\n", mstime($stop - $start, 500, 1000), colourize("ok");
 109     }
 110 }
 111
 112 while (<$fh>)
 113 {
 114     chomp;
 115     s/\r//g;
 116
 117     if (/^\s*Testing "(.*)" in (.*):\s*$/)
 118     {
 119         alarm(120);
 120         my ($sect, $file) = ($1, $2);
 121
 122         endsect();
 123
 124         printf("! %s  %s: ", $file, $sect);
 125         @log = ();
 126         $start = $stop;
 127     }
 128     elsif (/^!\s*(.*?)\s+(\S+)\s*$/)
 129     {
 130         alarm(120);
 131
 132         my ($name, $result) = ($1, $2);
 133         my $pass = ($result eq "ok");
 134
 135         if (!$start) {
 136             printf("\n! Startup: ");
 137             $start = time();
 138         }
 139
 140         push @log, resultline($name, $result);
 141
 142         if (!$pass) {
 143             $gfails++;
 144             if (@log) {
 145                 print "\n" . join("\n", @log) . "\n";
 146                 @log = ();
 147             }
 148         } else {
 149             $gpasses++;
 150             print ".";
 151         }
 152     }
 153     else
 154     {
 155         push @log, $_;
 156     }
 157 }
 158
 159 endsect();
 160
 161 my $newpid = waitpid($pid, 0);
 162 if ($newpid != $pid) {
 163     die("waitpid returned '$newpid', expected '$pid'\n");
 164 }
 165
 166 my $code = $?;
 167 my $ret = ($code >> 8);
 168
 169 # return death-from-signal exits as >128.  This is what bash does if you ran
 170 # the program directly.
 171 if ($code && !$ret) { $ret = $code | 128; }
 172
 173 if ($ret && @log) {
 174     print "\n" . join("\n", @log) . "\n";
 175 }
 176
 177 if ($code != 0) {
 178     print resultline("Program returned non-zero exit code ($ret)", "FAILED");
 179 }
 180
 181 my $gtotal = $gpasses+$gfails;
 182 printf("\nWvTest: %d test%s, %d failure%s, total time %s.\n",
 183     $gtotal, $gtotal==1 ? "" : "s",
 184     $gfails, $gfails==1 ? "" : "s",
 185     mstime(time() - $allstart, 2000, 5000));
 186 print STDERR "\nWvTest result code: $ret\n";
 187 exit( $ret ? $ret : ($gfails ? 125 : 0) );