From: Michael G. Schwern <schwern@pobox.com>
Date: Sat, 5 Jul 2003 13:34:37 +0000 (-0700)
Subject: Re: maint @ 19975 [PATCH lib/Test/Harness.pm]
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5c0604c31705f2b57a4886181c5401ec3439302b;p=p5sagit%2Fp5-mst-13.2.git

Re: maint @ 19975 [PATCH lib/Test/Harness.pm]
Message-ID: <20030705203437.GB2598@windhund.schwern.org>

Print out the "ok" messages only once every second,
this should make output much less and therefore testing
much faster, especially on slower connections.

p4raw-id: //depot/perl@20023
---

diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 4023279..742ea4e 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -13,12 +13,12 @@ use strict;
 
 use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest
             $Columns $verbose $switches $ML $Strap
-            @ISA @EXPORT @EXPORT_OK
+            @ISA @EXPORT @EXPORT_OK $Last_ML_Print
            );
 
 # Backwards compatibility for exportable variable names.
-*verbose  = \$Verbose;
-*switches = \$Switches;
+*verbose  = *Verbose;
+*switches = *Switches;
 
 $Have_Devel_Corestack = 0;
 
@@ -449,7 +449,7 @@ sub _run_all_tests {
 
     my $width = _leader_width(@tests);
     foreach my $tfile (@tests) {
-
+        $Last_ML_Print = 0;  # so each test prints at least once
         my($leader, $ml) = _mk_leader($tfile, $width);
         local $ML = $ml;
         print $leader;
@@ -706,7 +706,7 @@ $Handlers{test} = sub {
     my $detail = $totals->{details}[-1];
 
     if( $detail->{ok} ) {
-        _print_ml("ok $curr/$max");
+        _print_ml_less("ok $curr/$max");
 
         if( $detail->{type} eq 'skip' ) {
             $totals->{skip_reason} = $detail->{reason}
@@ -742,6 +742,15 @@ sub _print_ml {
 }
 
 
+# For slow connections, we save lots of bandwidth by printing only once
+# per second.
+sub _print_ml_less {
+    if( $Last_ML_Print != time ) {
+        _print_ml(@_);
+        $Last_ML_Print = time;
+    }
+}
+
 sub _bonusmsg {
     my($tot) = @_;