wvtest

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