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