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