diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 1999-05-11 15:27:40 +0000 |
---|---|---|
committer | Gurusamy Sarathy <gsar@cpan.org> | 1999-05-11 15:27:40 +0000 |
commit | 0d0c0d42fe2aa4166c71f4cca8101e39e114387b (patch) | |
tree | 0e097d2aba1b3eb033a2d878a82531b4e38fc233 /lib/Test | |
parent | c854dc73dd785a05dca58d094503a8e06b4b3220 (diff) | |
download | perl-0d0c0d42fe2aa4166c71f4cca8101e39e114387b.tar.gz |
display more frequent progress messages when STDOUT is a tty
p4raw-id: //depot/perl@3390
Diffstat (limited to 'lib/Test')
-rw-r--r-- | lib/Test/Harness.pm | 21 |
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 |