X-Git-Url: https://arthur.barton.de/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=wvtest;h=7d494f348185713ea0c44d80d9959ea74448f936;hb=9fc0171c58dd467586f70251228a39a486d35673;hp=109b223df0bbe28ad71e200a65e872c2247bd1d6;hpb=6d329a615b06e75c0a027ced89fb320bb262c9a0;p=bup.git diff --git a/wvtest b/wvtest index 109b223..7d494f3 100755 --- a/wvtest +++ b/wvtest @@ -8,24 +8,19 @@ # use strict; use warnings; +use Getopt::Long qw(GetOptionsFromArray :config no_ignore_case bundling); +use Pod::Usage; use Time::HiRes qw(time); +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 = (); -sub usage -{ - my ($fh) = @_; - print $fh "Usage: $0 run \n"; -} - -sub usage_death() -{ - usage(\*STDERR); - exit 127; -} - sub bigkill($) { my $pid = shift; @@ -90,18 +85,31 @@ 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"); } } -sub run() +sub run { - usage_death() if (@ARGV < 1); + # 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; - print STDERR "Testing \"all\" in @ARGV:\n"; + { + my $msg = "Testing \"all\" in @ARGV:\n"; + print $msg; + print STDERR $msg if $dup_msgs; + } $pid = open(my $fh, "-|"); if (!$pid) { @@ -117,7 +125,8 @@ sub run() 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"; + print STDERR resultline('Alarm timed out! No test results for too long.\n', + 'FAILED'); bigkill($pid); }; @@ -129,7 +138,7 @@ sub run() if (/^\s*Testing "(.*)" in (.*):\s*$/) { - alarm(120); + alarm(300); my ($sect, $file) = ($1, $2); endsect(); @@ -140,7 +149,7 @@ sub run() } elsif (/^!\s*(.*?)\s+(\S+)\s*$/) { - alarm(120); + alarm(300); my ($name, $result) = ($1, $2); my $pass = ($result eq "ok"); @@ -188,25 +197,129 @@ sub run() } if ($code != 0) { - print resultline("Program returned non-zero exit code ($ret)", "FAILED"); + 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; + } + { + 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; } + return ($ret ? $ret : ($gfails ? 125 : 0)); +} + +sub report() +{ + my ($gpasses, $gfails) = (0,0); + for my $f (@ARGV) + { + my $fh; + open($fh, '<:crlf', $f) or die "Unable to open $f: $!"; + while (<$fh>) + { + chomp; + s/\r//g; - 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) ); + 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); } -usage_death() unless (@ARGV > 1); +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); } -if ($action eq 'run') { - run(); -} -else { - usage_death(); -} +__END__ + +=head1 NAME + +wvtest - the dumbest cross-platform test framework that could possibly work + +=head1 SYNOPSIS + + 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 + +=cut