wvtestrunner.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 # always flush
   5 $| = 1;
   6
   7 if (@ARGV < 1) {
   8     print STDERR "Usage: $0 <command line...>\n";
   9     exit 127;
  10 }
  11
  12 print STDERR "Testing \"all\" in @ARGV:\n";
  13
  14 my $pid = open(my $fh, "-|");
  15 if (!$pid) {
  16     # child
  17     setpgrp();
  18     open STDERR, '>&STDOUT' or die("Can't dup stdout: $!\n");
  19     exec(@ARGV);
  20     exit 126; # just in case
  21 }
  22
  23 my $istty = -t STDOUT;
  24 my @log = ();
  25 my ($gpasses, $gfails) = (0,0);
  26
  27 sub bigkill($)
  28 {
  29     my $pid = shift;
  30
  31     if (@log) {
  32         print "\n" . join("\n", @log) . "\n";
  33     }
  34
  35     print STDERR "\n! Killed by signal    FAILED\n";
  36
  37     ($pid > 0) || die("pid is '$pid'?!\n");
  38
  39     local $SIG{CHLD} = sub { }; # this will wake us from sleep() faster
  40     kill 15, $pid;
  41     sleep(2);
  42
  43     if ($pid > 1) {
  44         kill 9, -$pid;
  45     }
  46     kill 9, $pid;
  47
  48     exit(125);
  49 }
  50
  51 # parent
  52 local $SIG{INT} = sub { bigkill($pid); };
  53 local $SIG{TERM} = sub { bigkill($pid); };
  54 local $SIG{ALRM} = sub {
  55     print STDERR "Alarm timed out!  No test results for too long.\n";
  56     bigkill($pid);
  57 };
  58
  59 sub colourize($)
  60 {
  61     my $result = shift;
  62     my $pass = ($result eq "ok");
  63
  64     if ($istty) {
  65         my $colour = $pass ? "\e[32;1m" : "\e[31;1m";
  66         return "$colour$result\e[0m";
  67     } else {
  68         return $result;
  69     }
  70 }
  71
  72 sub resultline($$)
  73 {
  74     my ($name, $result) = @_;
  75     return sprintf("! %-65s %s", $name, colourize($result));
  76 }
  77
  78 my $insection = 0;
  79
  80 while (<$fh>)
  81 {
  82     chomp;
  83     s/\r//g;
  84
  85     if (/^\s*Testing "(.*)" in (.*):\s*$/)
  86     {
  87         alarm(120);
  88
  89         my ($sect, $file) = ($1, $2);
  90
  91         if ($insection) {
  92             printf " %s\n", colourize("ok");
  93         }
  94
  95         printf("! %s  %s: ", $file, $sect);
  96         @log = ();
  97         $insection = 1;
  98     }
  99     elsif (/^!\s*(.*?)\s+(\S+)\s*$/)
 100     {
 101         alarm(120);
 102
 103         my ($name, $result) = ($1, $2);
 104         my $pass = ($result eq "ok");
 105
 106         if (!$insection) {
 107             printf("\n! Startup: ");
 108         }
 109         $insection++;
 110
 111         push @log, resultline($name, $result);
 112
 113         if (!$pass) {
 114             $gfails++;
 115             if (@log) {
 116                 print "\n" . join("\n", @log) . "\n";
 117                 @log = ();
 118             }
 119         } else {
 120             $gpasses++;
 121             print ".";
 122         }
 123     }
 124     else
 125     {
 126         push @log, $_;
 127     }
 128 }
 129
 130 if ($insection) {
 131     printf " %s\n", colourize("ok");
 132 }
 133
 134 my $newpid = waitpid($pid, 0);
 135 if ($newpid != $pid) {
 136     die("waitpid returned '$newpid', expected '$pid'\n");
 137 }
 138
 139 my $code = $?;
 140 my $ret = ($code >> 8);
 141
 142 if ($ret && @log) {
 143     print "\n" . join("\n", @log) . "\n";
 144 }
 145
 146
 147 my $gtotal = $gpasses+$gfails;
 148 printf("\nWvTest: %d test%s, %d failure%s.\n",
 149     $gtotal, $gtotal==1 ? "" : "s",
 150     $gfails, $gfails==1 ? "" : "s");
 151 print STDERR "\nWvTest result code: $ret\n";
 152 exit( $ret ? $ret : ($gfails ? 125 : 0) );