summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1999-05-11 15:27:40 +0000
committerGurusamy Sarathy <gsar@cpan.org>1999-05-11 15:27:40 +0000
commit0d0c0d42fe2aa4166c71f4cca8101e39e114387b (patch)
tree0e097d2aba1b3eb033a2d878a82531b4e38fc233 /lib
parentc854dc73dd785a05dca58d094503a8e06b4b3220 (diff)
downloadperl-0d0c0d42fe2aa4166c71f4cca8101e39e114387b.tar.gz
display more frequent progress messages when STDOUT is a tty
p4raw-id: //depot/perl@3390
Diffstat (limited to 'lib')
-rw-r--r--lib/Test/Harness.pm21
1 files changed, 16 insertions, 5 deletions
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index e4becb5d17..866551328c 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -11,7 +11,7 @@ use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest
@ISA @EXPORT @EXPORT_OK);
$have_devel_corestack = 0;
-$VERSION = "1.1603";
+$VERSION = "1.1604";
$ENV{HARNESS_ACTIVE} = 1;
@@ -74,7 +74,10 @@ sub runtests {
$te = $test;
chop($te);
if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./; }
- print "$te" . '.' x (20 - length($te));
+ my $leader = "$te" . '.' x (20 - length($te));
+ my $ml = "";
+ $ml = "\r$leader" if -t STDOUT and not $ENV{HARNESS_NOTTY};
+ print $leader;
my $fh = new FileHandle;
$fh->open($test) or print "can't open $test. $!\n";
my $first = <$fh>;
@@ -111,6 +114,7 @@ sub runtests {
my $this = $next;
if (/^not ok\s*(\d*)/){
$this = $1 if $1 > 0;
+ print "${ml}NOK $this \n" if $ml;
if (!$todo{$this}) {
push @failed, $this;
} else {
@@ -119,6 +123,7 @@ sub runtests {
}
} elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip\S*(?:(?>\s+)(.+))?)?/) {
$this = $1 if $1 > 0;
+ print "${ml}ok $this " if $ml;
$ok++;
$totok++;
$skipped++ if defined $2;
@@ -154,7 +159,7 @@ sub runtests {
: $wstatus >> 8);
if ($wstatus) {
my ($failed, $canon, $percent) = ('??', '??');
- printf "dubious\n\tTest returned status $estatus (wstat %d, 0x%x)\n",
+ printf "${ml}dubious\n\tTest returned status $estatus (wstat %d, 0x%x)\n",
$wstatus,$wstatus;
print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
if (corestatus($wstatus)) { # until we have a wait module
@@ -191,9 +196,9 @@ sub runtests {
push(@msg, "$bonus subtest".($bonus>1?'s':'').
" unexpectedly succeeded")
if $bonus;
- print "ok, ".join(', ', @msg)."\n";
+ print "${ml}ok, ".join(', ', @msg)." \n";
} elsif ($max) {
- print "ok\n";
+ print "${ml}ok \n";
} else {
print "skipping test on this platform\n";
$tests_skipped++;
@@ -461,6 +466,12 @@ above messages.
Setting C<HARNESS_IGNORE_EXITCODE> makes harness ignore the exit status
of child processes.
+Setting C<HARNESS_NOTTY> to a true value forces it to behave as though
+STDOUT were not a console. You may need to set this if you don't want
+harness to output more frequent progress messages using carriage returns.
+Some consoles may not handle carriage returns properly (which results
+in a somewhat messy output).
+
If C<HARNESS_FILELEAK_IN_DIR> is set to the name of a directory, harness
will check after each test whether new files appeared in that directory,
and report them as