X-Git-Url: https://arthur.barton.de/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=wvtest;h=7d494f348185713ea0c44d80d9959ea74448f936;hb=37a70d69445ffb765688257b79ecffb3ff0a0908;hp=2359bce73016ced9d890d841e6df533d4af75082;hpb=cd7fd23606bf833d4cde02b63e6d1e2e99466235;p=bup.git diff --git a/wvtest b/wvtest index 2359bce..7d494f3 100755 --- a/wvtest +++ b/wvtest @@ -8,32 +8,18 @@ # 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 $per_test_warn_time = 100000; # upstream was 500 +my $per_test_bad_time = 100000; # upstream was 1000 +my $overall_test_warn_time = 100000; # upstream was 2000 +my $overall_test_bad_time = 100000; # upstream was 5000 +my $pid; my $istty = -t STDOUT; my @log = (); -my ($gpasses, $gfails) = (0,0); sub bigkill($) { @@ -59,14 +45,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,90 +79,247 @@ sub resultline($$) return sprintf("! %-65s %s", $name, colourize($result)); } -my $allstart = time(); my ($start, $stop); sub endsect() { $stop = time(); if ($start) { - printf " %s %s\n", mstime($stop - $start, 500, 1000), colourize("ok"); + printf " %s %s\n", + mstime($stop - $start, $per_test_warn_time, $per_test_bad_time), + colourize("ok"); } } -while (<$fh>) +sub run { - chomp; - s/\r//g; + # dup_msgs should be true when "watching". In that case all top + # level wvtest protocol messages should be duplicated to stderr so + # that they can be safely captured for report to process later. + my ($dup_msgs) = @_; + my $show_counts = 1; + GetOptionsFromArray(\@ARGV, 'counts!', \$show_counts) + or pod2usage(); + pod2usage('$0: no command specified') if (@ARGV < 1); + + # always flush + $| = 1; + + { + my $msg = "Testing \"all\" in @ARGV:\n"; + print $msg; + print STDERR $msg if $dup_msgs; + } - if (/^\s*Testing "(.*)" in (.*):\s*$/) + $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 + } + + # parent + my $allstart = time(); + local $SIG{INT} = sub { bigkill($pid); }; + local $SIG{TERM} = sub { bigkill($pid); }; + local $SIG{ALRM} = sub { + print STDERR resultline('Alarm timed out! No test results for too long.\n', + 'FAILED'); + 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(300); + my ($sect, $file) = ($1, $2); + + endsect(); + + printf("! %s %s: ", $file, $sect); + @log = (); + $start = $stop; + } + elsif (/^!\s*(.*?)\s+(\S+)\s*$/) + { + alarm(300); + + 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(); + + my $newpid = waitpid($pid, 0); + if ($newpid != $pid) { + die("waitpid returned '$newpid', expected '$pid'\n"); + } + + my $code = $?; + my $ret = ($code >> 8); - endsect(); + # return death-from-signal exits as >128. This is what bash does if you ran + # the program directly. + if ($code && !$ret) { $ret = $code | 128; } - printf("! %s %s: ", $file, $sect); - @log = (); - $start = $stop; + if ($ret && @log) { + print "\n" . join("\n", @log) . "\n"; + } + + if ($code != 0) { + my $msg = resultline("Program returned non-zero exit code ($ret)", + 'FAILED'); + print $msg; + print STDERR "$msg\n" if $dup_msgs; + } + + print "\n"; + if ($show_counts) { + my $gtotal = $gpasses + $gfails; + my $msg = sprintf("WvTest: %d test%s, %d failure%s\n", + $gtotal, $gtotal == 1 ? "" : "s", $gfails, + $gfails == 1 ? "" : "s"); + print $msg; + print STDERR $msg if $dup_msgs; } - 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 $msg = sprintf("WvTest: result code $ret, total time %s\n", + mstime(time() - $allstart, + $overall_test_warn_time, + $overall_test_bad_time)); + print $msg; + print STDERR $msg if $dup_msgs; } - else + 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(0); } +elsif ($action eq 'watch') { run(1); } +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. Note that watch's stderr will + # include copies of any top level messages - reporting non-zero + # test command exits, etc., and so must be included in the report arguments. + wvtest watch --no-counts \ + "sh -c '(test-1 2>&1 | tee test-1.log)& (test-2 2>&1 | tee test-2.log)&'" \ + 2>test-3.log \ + wvtest report test-1.log test-2.log test-3.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