X-Git-Url: https://arthur.barton.de/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=wvtest;h=7541ebd63b951f30e047336a60d5db7161785e1a;hb=aa29a8483010e4c63f3a3d9234080f9b7fcd8a35;hp=2359bce73016ced9d890d841e6df533d4af75082;hpb=cd7fd23606bf833d4cde02b63e6d1e2e99466235;p=bup.git diff --git a/wvtest b/wvtest index 2359bce..7541ebd 100755 --- a/wvtest +++ b/wvtest @@ -8,32 +8,13 @@ # use strict; use warnings; +use Getopt::Long qw(GetOptionsFromArray :config no_ignore_case bundling); +use Pod::Usage; use Time::HiRes qw(time); -# always flush -$| = 1; - -if (@ARGV < 2 || $ARGV[0] ne 'run') { - print STDERR "Usage: run $0 \n"; - exit 127; -} - -shift @ARGV; - -print STDERR "Testing \"all\" in @ARGV:\n"; - -my $pid = open(my $fh, "-|"); -if (!$pid) { - # child - setpgrp(); - open STDERR, '>&STDOUT' or die("Can't dup stdout: $!\n"); - exec(@ARGV); - exit 126; # just in case -} - +my $pid; my $istty = -t STDOUT; my @log = (); -my ($gpasses, $gfails) = (0,0); sub bigkill($) { @@ -59,14 +40,6 @@ sub bigkill($) exit(125); } -# parent -local $SIG{INT} = sub { bigkill($pid); }; -local $SIG{TERM} = sub { bigkill($pid); }; -local $SIG{ALRM} = sub { - print STDERR "Alarm timed out! No test results for too long.\n"; - bigkill($pid); -}; - sub colourize($) { my $result = shift; @@ -101,7 +74,6 @@ sub resultline($$) return sprintf("! %-65s %s", $name, colourize($result)); } -my $allstart = time(); my ($start, $stop); sub endsect() @@ -112,79 +84,212 @@ sub endsect() } } -while (<$fh>) +sub run() { - chomp; - s/\r//g; + my $show_counts = 1; + GetOptionsFromArray(\@ARGV, 'counts!', \$show_counts) + or pod2usage(); + pod2usage('$0: no command specified') if (@ARGV < 1); + + # always flush + $| = 1; + + print STDERR "Testing \"all\" in @ARGV:\n"; + + $pid = open(my $fh, "-|"); + if (!$pid) { + # child + setpgrp(); + open STDERR, '>&STDOUT' or die("Can't dup stdout: $!\n"); + exec(@ARGV); + exit 126; # just in case + } - if (/^\s*Testing "(.*)" in (.*):\s*$/) + # parent + my $allstart = time(); + local $SIG{INT} = sub { bigkill($pid); }; + local $SIG{TERM} = sub { bigkill($pid); }; + local $SIG{ALRM} = sub { + print STDERR "Alarm timed out! No test results for too long.\n"; + bigkill($pid); + }; + + my ($gpasses, $gfails) = (0,0); + while (<$fh>) { - alarm(120); - my ($sect, $file) = ($1, $2); + chomp; + s/\r//g; + + if (/^\s*Testing "(.*)" in (.*):\s*$/) + { + alarm(120); + my ($sect, $file) = ($1, $2); + + endsect(); + + printf("! %s %s: ", $file, $sect); + @log = (); + $start = $stop; + } + elsif (/^!\s*(.*?)\s+(\S+)\s*$/) + { + alarm(120); + + my ($name, $result) = ($1, $2); + my $pass = ($result eq "ok"); + + if (!$start) { + printf("\n! Startup: "); + $start = time(); + } + + push @log, resultline($name, $result); + + if (!$pass) { + $gfails++; + if (@log) { + print "\n" . join("\n", @log) . "\n"; + @log = (); + } + } else { + $gpasses++; + print "."; + } + } + else + { + push @log, $_; + } + } - endsect(); + endsect(); - printf("! %s %s: ", $file, $sect); - @log = (); - $start = $stop; + my $newpid = waitpid($pid, 0); + if ($newpid != $pid) { + die("waitpid returned '$newpid', expected '$pid'\n"); } - elsif (/^!\s*(.*?)\s+(\S+)\s*$/) - { - alarm(120); - - my ($name, $result) = ($1, $2); - my $pass = ($result eq "ok"); - - if (!$start) { - printf("\n! Startup: "); - $start = time(); - } - - push @log, resultline($name, $result); - - if (!$pass) { - $gfails++; - if (@log) { - print "\n" . join("\n", @log) . "\n"; - @log = (); - } - } else { - $gpasses++; - print "."; - } + + my $code = $?; + my $ret = ($code >> 8); + + # return death-from-signal exits as >128. This is what bash does if you ran + # the program directly. + if ($code && !$ret) { $ret = $code | 128; } + + if ($ret && @log) { + print "\n" . join("\n", @log) . "\n"; + } + + if ($code != 0) { + print resultline("Program returned non-zero exit code ($ret)", "FAILED"); } - else + + print "\n"; + if ($show_counts) { + my $gtotal = $gpasses + $gfails; + printf("WvTest: %d test%s, %d failure%s\n", + $gtotal, $gtotal==1 ? "" : "s", + $gfails, $gfails==1 ? "" : "s"); + } + printf("WvTest: result code $ret, total time %s\n", + mstime(time() - $allstart, 2000, 5000)); + return ($ret ? $ret : ($gfails ? 125 : 0)); +} + +sub report() +{ + my ($gpasses, $gfails) = (0,0); + for my $f (@ARGV) { - push @log, $_; + my $fh; + open($fh, '<:crlf', $f) or die "Unable to open $f: $!"; + while (<$fh>) + { + chomp; + s/\r//g; + + if (/^\s*Testing "(.*)" in (.*):\s*$/) { + @log = (); + } + elsif (/^!\s*(.*?)\s+(\S+)\s*$/) { + my ($name, $result) = ($1, $2); + my $pass = ($result eq "ok"); + push @log, resultline($name, $result); + if (!$pass) { + $gfails++; + if (@log) { + print "\n" . join("\n", @log) . "\n"; + @log = (); + } + } else { + $gpasses++; + } + } + else + { + push @log, $_; + } + } } + my $gtotal = $gpasses + $gfails; + printf("\nWvTest: %d test%s, %d failure%s\n", + $gtotal, $gtotal == 1 ? "" : "s", + $gfails, $gfails == 1 ? "" : "s"); + return ($gfails ? 125 : 0); } -endsect(); +my ($show_help, $show_manual); +Getopt::Long::Configure('no_permute'); +GetOptionsFromArray(\@ARGV, + 'help|?' => \$show_help, + 'man' => \$show_manual) or pod2usage(); +Getopt::Long::Configure('permute'); +pod2usage(-verbose => 1, -exitval => 0) if $show_help; +pod2usage(-verbose => 2, -exitval => 0) if $show_manual; +pod2usage(-msg => "$0: no action specified", -verbose => 1) if (@ARGV < 1); + +my $action = $ARGV[0]; +shift @ARGV; +if ($action eq 'run') { exit run(); } +elsif ($action eq 'watch') { run(); } +elsif ($action eq 'report') { exit report(); } +else { pod2usage(-msg => "$0: invalid action $action", -verbose => 1); } -my $newpid = waitpid($pid, 0); -if ($newpid != $pid) { - die("waitpid returned '$newpid', expected '$pid'\n"); -} +__END__ -my $code = $?; -my $ret = ($code >> 8); +=head1 NAME -# return death-from-signal exits as >128. This is what bash does if you ran -# the program directly. -if ($code && !$ret) { $ret = $code | 128; } +wvtest - the dumbest cross-platform test framework that could possibly work -if ($ret && @log) { - print "\n" . join("\n", @log) . "\n"; -} +=head1 SYNOPSIS -if ($code != 0) { - print resultline("Program returned non-zero exit code ($ret)", "FAILED"); -} + wvtest [GLOBAL...] run [RUN_OPT...] [--] command [arg...] + wvtest [GLOBAL...] watch [RUN_OPT...] [--] command [arg...] + wvtest [GLOBAL...] report [logfile...] + + GLOBAL: + --help, -? display brief help message and exit + --man display full documentation + RUN_OPT: + --[no-]counts [don't] show success/failure counts + +=head1 DESCRIPTION + +B will run some-tests and report on the result. +This should work fine as long as some-tests doesn't run any sub-tests +in parallel. + +If you'd like to run your tests in parallel, use B and +B as described in the EXAMPLES below. + +=head1 EXAMPLES + + # Fine if ./tests doesn't produce any output in parallel. + wvtest run ./tests + + # Use watch and report for parallel tests. + wvtest watch --no-counts \ + sh -c '(test-1 2>&1 | tee test-1.log)& (test-2 2>&1 | tee test-2.log)&' + wvtest report test-1.log test-2.log -my $gtotal = $gpasses+$gfails; -printf("\nWvTest: %d test%s, %d failure%s, total time %s.\n", - $gtotal, $gtotal==1 ? "" : "s", - $gfails, $gfails==1 ? "" : "s", - mstime(time() - $allstart, 2000, 5000)); -print STDERR "\nWvTest result code: $ret\n"; -exit( $ret ? $ret : ($gfails ? 125 : 0) ); +=cut