#
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 <command line...>\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($)
{
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;
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<wvtest run some-tests> 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<watch> and
+B<report> 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
projects / bup.git / blobdiff