xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/Test/Harness.pm (revision 0:68f95e015346)
1*0Sstevel@tonic-gate# -*- Mode: cperl; cperl-indent-level: 4 -*-
2*0Sstevel@tonic-gate# $Id: Harness.pm,v 1.80 2003/12/31 02:39:21 andy Exp $
3*0Sstevel@tonic-gate
4*0Sstevel@tonic-gatepackage Test::Harness;
5*0Sstevel@tonic-gate
6*0Sstevel@tonic-gaterequire 5.004;
7*0Sstevel@tonic-gateuse Test::Harness::Straps;
8*0Sstevel@tonic-gateuse Test::Harness::Assert;
9*0Sstevel@tonic-gateuse Exporter;
10*0Sstevel@tonic-gateuse Benchmark;
11*0Sstevel@tonic-gateuse Config;
12*0Sstevel@tonic-gateuse strict;
13*0Sstevel@tonic-gate
14*0Sstevel@tonic-gateuse vars qw(
15*0Sstevel@tonic-gate    $VERSION
16*0Sstevel@tonic-gate    @ISA @EXPORT @EXPORT_OK
17*0Sstevel@tonic-gate    $Verbose $Switches $Debug
18*0Sstevel@tonic-gate    $verbose $switches $debug
19*0Sstevel@tonic-gate    $Have_Devel_Corestack
20*0Sstevel@tonic-gate    $Curtest
21*0Sstevel@tonic-gate    $Columns
22*0Sstevel@tonic-gate    $ML $Last_ML_Print
23*0Sstevel@tonic-gate    $Strap
24*0Sstevel@tonic-gate);
25*0Sstevel@tonic-gate
26*0Sstevel@tonic-gate=head1 NAME
27*0Sstevel@tonic-gate
28*0Sstevel@tonic-gateTest::Harness - Run Perl standard test scripts with statistics
29*0Sstevel@tonic-gate
30*0Sstevel@tonic-gate=head1 VERSION
31*0Sstevel@tonic-gate
32*0Sstevel@tonic-gateVersion 2.40
33*0Sstevel@tonic-gate
34*0Sstevel@tonic-gate    $Header: /home/cvs/test-harness/lib/Test/Harness.pm,v 1.80 2003/12/31 02:39:21 andy Exp $
35*0Sstevel@tonic-gate
36*0Sstevel@tonic-gate=cut
37*0Sstevel@tonic-gate
38*0Sstevel@tonic-gate$VERSION = '2.40';
39*0Sstevel@tonic-gate
40*0Sstevel@tonic-gate# Backwards compatibility for exportable variable names.
41*0Sstevel@tonic-gate*verbose  = *Verbose;
42*0Sstevel@tonic-gate*switches = *Switches;
43*0Sstevel@tonic-gate*debug    = *Debug;
44*0Sstevel@tonic-gate
45*0Sstevel@tonic-gate$Have_Devel_Corestack = 0;
46*0Sstevel@tonic-gate
47*0Sstevel@tonic-gate$ENV{HARNESS_ACTIVE} = 1;
48*0Sstevel@tonic-gate
49*0Sstevel@tonic-gateEND {
50*0Sstevel@tonic-gate    # For VMS.
51*0Sstevel@tonic-gate    delete $ENV{HARNESS_ACTIVE};
52*0Sstevel@tonic-gate}
53*0Sstevel@tonic-gate
54*0Sstevel@tonic-gate# Some experimental versions of OS/2 build have broken $?
55*0Sstevel@tonic-gatemy $Ignore_Exitcode = $ENV{HARNESS_IGNORE_EXITCODE};
56*0Sstevel@tonic-gate
57*0Sstevel@tonic-gatemy $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
58*0Sstevel@tonic-gate
59*0Sstevel@tonic-gatemy $Ok_Slow = $ENV{HARNESS_OK_SLOW};
60*0Sstevel@tonic-gate
61*0Sstevel@tonic-gate$Strap = Test::Harness::Straps->new;
62*0Sstevel@tonic-gate
63*0Sstevel@tonic-gate@ISA = ('Exporter');
64*0Sstevel@tonic-gate@EXPORT    = qw(&runtests);
65*0Sstevel@tonic-gate@EXPORT_OK = qw($verbose $switches);
66*0Sstevel@tonic-gate
67*0Sstevel@tonic-gate$Verbose  = $ENV{HARNESS_VERBOSE} || 0;
68*0Sstevel@tonic-gate$Debug    = $ENV{HARNESS_DEBUG} || 0;
69*0Sstevel@tonic-gate$Switches = "-w";
70*0Sstevel@tonic-gate$Columns  = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
71*0Sstevel@tonic-gate$Columns--;             # Some shells have trouble with a full line of text.
72*0Sstevel@tonic-gate
73*0Sstevel@tonic-gate=head1 SYNOPSIS
74*0Sstevel@tonic-gate
75*0Sstevel@tonic-gate  use Test::Harness;
76*0Sstevel@tonic-gate
77*0Sstevel@tonic-gate  runtests(@test_files);
78*0Sstevel@tonic-gate
79*0Sstevel@tonic-gate=head1 DESCRIPTION
80*0Sstevel@tonic-gate
81*0Sstevel@tonic-gateB<STOP!> If all you want to do is write a test script, consider using
82*0Sstevel@tonic-gateTest::Simple.  Otherwise, read on.
83*0Sstevel@tonic-gate
84*0Sstevel@tonic-gate(By using the Test module, you can write test scripts without
85*0Sstevel@tonic-gateknowing the exact output this module expects.  However, if you need to
86*0Sstevel@tonic-gateknow the specifics, read on!)
87*0Sstevel@tonic-gate
88*0Sstevel@tonic-gatePerl test scripts print to standard output C<"ok N"> for each single
89*0Sstevel@tonic-gatetest, where C<N> is an increasing sequence of integers. The first line
90*0Sstevel@tonic-gateoutput by a standard test script is C<"1..M"> with C<M> being the
91*0Sstevel@tonic-gatenumber of tests that should be run within the test
92*0Sstevel@tonic-gatescript. Test::Harness::runtests(@tests) runs all the testscripts
93*0Sstevel@tonic-gatenamed as arguments and checks standard output for the expected
94*0Sstevel@tonic-gateC<"ok N"> strings.
95*0Sstevel@tonic-gate
96*0Sstevel@tonic-gateAfter all tests have been performed, runtests() prints some
97*0Sstevel@tonic-gateperformance statistics that are computed by the Benchmark module.
98*0Sstevel@tonic-gate
99*0Sstevel@tonic-gate=head2 The test script output
100*0Sstevel@tonic-gate
101*0Sstevel@tonic-gateThe following explains how Test::Harness interprets the output of your
102*0Sstevel@tonic-gatetest program.
103*0Sstevel@tonic-gate
104*0Sstevel@tonic-gate=over 4
105*0Sstevel@tonic-gate
106*0Sstevel@tonic-gate=item B<'1..M'>
107*0Sstevel@tonic-gate
108*0Sstevel@tonic-gateThis header tells how many tests there will be.  For example, C<1..10>
109*0Sstevel@tonic-gatemeans you plan on running 10 tests.  This is a safeguard in case your
110*0Sstevel@tonic-gatetest dies quietly in the middle of its run.
111*0Sstevel@tonic-gate
112*0Sstevel@tonic-gateIt should be the first non-comment line output by your test program.
113*0Sstevel@tonic-gate
114*0Sstevel@tonic-gateIn certain instances, you may not know how many tests you will
115*0Sstevel@tonic-gateultimately be running.  In this case, it is permitted for the 1..M
116*0Sstevel@tonic-gateheader to appear as the B<last> line output by your test (again, it
117*0Sstevel@tonic-gatecan be followed by further comments).
118*0Sstevel@tonic-gate
119*0Sstevel@tonic-gateUnder B<no> circumstances should 1..M appear in the middle of your
120*0Sstevel@tonic-gateoutput or more than once.
121*0Sstevel@tonic-gate
122*0Sstevel@tonic-gate
123*0Sstevel@tonic-gate=item B<'ok', 'not ok'.  Ok?>
124*0Sstevel@tonic-gate
125*0Sstevel@tonic-gateAny output from the testscript to standard error is ignored and
126*0Sstevel@tonic-gatebypassed, thus will be seen by the user. Lines written to standard
127*0Sstevel@tonic-gateoutput containing C</^(not\s+)?ok\b/> are interpreted as feedback for
128*0Sstevel@tonic-gateruntests().  All other lines are discarded.
129*0Sstevel@tonic-gate
130*0Sstevel@tonic-gateC</^not ok/> indicates a failed test.  C</^ok/> is a successful test.
131*0Sstevel@tonic-gate
132*0Sstevel@tonic-gate
133*0Sstevel@tonic-gate=item B<test numbers>
134*0Sstevel@tonic-gate
135*0Sstevel@tonic-gatePerl normally expects the 'ok' or 'not ok' to be followed by a test
136*0Sstevel@tonic-gatenumber.  It is tolerated if the test numbers after 'ok' are
137*0Sstevel@tonic-gateomitted. In this case Test::Harness maintains temporarily its own
138*0Sstevel@tonic-gatecounter until the script supplies test numbers again. So the following
139*0Sstevel@tonic-gatetest script
140*0Sstevel@tonic-gate
141*0Sstevel@tonic-gate    print <<END;
142*0Sstevel@tonic-gate    1..6
143*0Sstevel@tonic-gate    not ok
144*0Sstevel@tonic-gate    ok
145*0Sstevel@tonic-gate    not ok
146*0Sstevel@tonic-gate    ok
147*0Sstevel@tonic-gate    ok
148*0Sstevel@tonic-gate    END
149*0Sstevel@tonic-gate
150*0Sstevel@tonic-gatewill generate
151*0Sstevel@tonic-gate
152*0Sstevel@tonic-gate    FAILED tests 1, 3, 6
153*0Sstevel@tonic-gate    Failed 3/6 tests, 50.00% okay
154*0Sstevel@tonic-gate
155*0Sstevel@tonic-gate=item B<test names>
156*0Sstevel@tonic-gate
157*0Sstevel@tonic-gateAnything after the test number but before the # is considered to be
158*0Sstevel@tonic-gatethe name of the test.
159*0Sstevel@tonic-gate
160*0Sstevel@tonic-gate  ok 42 this is the name of the test
161*0Sstevel@tonic-gate
162*0Sstevel@tonic-gateCurrently, Test::Harness does nothing with this information.
163*0Sstevel@tonic-gate
164*0Sstevel@tonic-gate=item B<Skipping tests>
165*0Sstevel@tonic-gate
166*0Sstevel@tonic-gateIf the standard output line contains the substring C< # Skip> (with
167*0Sstevel@tonic-gatevariations in spacing and case) after C<ok> or C<ok NUMBER>, it is
168*0Sstevel@tonic-gatecounted as a skipped test.  If the whole testscript succeeds, the
169*0Sstevel@tonic-gatecount of skipped tests is included in the generated output.
170*0Sstevel@tonic-gateC<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason
171*0Sstevel@tonic-gatefor skipping.
172*0Sstevel@tonic-gate
173*0Sstevel@tonic-gate  ok 23 # skip Insufficient flogiston pressure.
174*0Sstevel@tonic-gate
175*0Sstevel@tonic-gateSimilarly, one can include a similar explanation in a C<1..0> line
176*0Sstevel@tonic-gateemitted if the test script is skipped completely:
177*0Sstevel@tonic-gate
178*0Sstevel@tonic-gate  1..0 # Skipped: no leverage found
179*0Sstevel@tonic-gate
180*0Sstevel@tonic-gate=item B<Todo tests>
181*0Sstevel@tonic-gate
182*0Sstevel@tonic-gateIf the standard output line contains the substring C< # TODO > after
183*0Sstevel@tonic-gateC<not ok> or C<not ok NUMBER>, it is counted as a todo test.  The text
184*0Sstevel@tonic-gateafterwards is the thing that has to be done before this test will
185*0Sstevel@tonic-gatesucceed.
186*0Sstevel@tonic-gate
187*0Sstevel@tonic-gate  not ok 13 # TODO harness the power of the atom
188*0Sstevel@tonic-gate
189*0Sstevel@tonic-gateNote that the TODO must have a space after it.
190*0Sstevel@tonic-gate
191*0Sstevel@tonic-gate=begin _deprecated
192*0Sstevel@tonic-gate
193*0Sstevel@tonic-gateAlternatively, you can specify a list of what tests are todo as part
194*0Sstevel@tonic-gateof the test header.
195*0Sstevel@tonic-gate
196*0Sstevel@tonic-gate  1..23 todo 5 12 23
197*0Sstevel@tonic-gate
198*0Sstevel@tonic-gateThis only works if the header appears at the beginning of the test.
199*0Sstevel@tonic-gate
200*0Sstevel@tonic-gateThis style is B<deprecated>.
201*0Sstevel@tonic-gate
202*0Sstevel@tonic-gate=end _deprecated
203*0Sstevel@tonic-gate
204*0Sstevel@tonic-gateThese tests represent a feature to be implemented or a bug to be fixed
205*0Sstevel@tonic-gateand act as something of an executable "thing to do" list.  They are
206*0Sstevel@tonic-gateB<not> expected to succeed.  Should a todo test begin succeeding,
207*0Sstevel@tonic-gateTest::Harness will report it as a bonus.  This indicates that whatever
208*0Sstevel@tonic-gateyou were supposed to do has been done and you should promote this to a
209*0Sstevel@tonic-gatenormal test.
210*0Sstevel@tonic-gate
211*0Sstevel@tonic-gate=item B<Bail out!>
212*0Sstevel@tonic-gate
213*0Sstevel@tonic-gateAs an emergency measure, a test script can decide that further tests
214*0Sstevel@tonic-gateare useless (e.g. missing dependencies) and testing should stop
215*0Sstevel@tonic-gateimmediately. In that case the test script prints the magic words
216*0Sstevel@tonic-gate
217*0Sstevel@tonic-gate  Bail out!
218*0Sstevel@tonic-gate
219*0Sstevel@tonic-gateto standard output. Any message after these words will be displayed by
220*0Sstevel@tonic-gateC<Test::Harness> as the reason why testing is stopped.
221*0Sstevel@tonic-gate
222*0Sstevel@tonic-gate=item B<Comments>
223*0Sstevel@tonic-gate
224*0Sstevel@tonic-gateAdditional comments may be put into the testing output on their own
225*0Sstevel@tonic-gatelines.  Comment lines should begin with a '#', Test::Harness will
226*0Sstevel@tonic-gateignore them.
227*0Sstevel@tonic-gate
228*0Sstevel@tonic-gate  ok 1
229*0Sstevel@tonic-gate  # Life is good, the sun is shining, RAM is cheap.
230*0Sstevel@tonic-gate  not ok 2
231*0Sstevel@tonic-gate  # got 'Bush' expected 'Gore'
232*0Sstevel@tonic-gate
233*0Sstevel@tonic-gate=item B<Anything else>
234*0Sstevel@tonic-gate
235*0Sstevel@tonic-gateAny other output Test::Harness sees it will silently ignore B<BUT WE
236*0Sstevel@tonic-gatePLAN TO CHANGE THIS!> If you wish to place additional output in your
237*0Sstevel@tonic-gatetest script, please use a comment.
238*0Sstevel@tonic-gate
239*0Sstevel@tonic-gate=back
240*0Sstevel@tonic-gate
241*0Sstevel@tonic-gate=head2 Taint mode
242*0Sstevel@tonic-gate
243*0Sstevel@tonic-gateTest::Harness will honor the C<-T> or C<-t> in the #! line on your
244*0Sstevel@tonic-gatetest files.  So if you begin a test with:
245*0Sstevel@tonic-gate
246*0Sstevel@tonic-gate    #!perl -T
247*0Sstevel@tonic-gate
248*0Sstevel@tonic-gatethe test will be run with taint mode on.
249*0Sstevel@tonic-gate
250*0Sstevel@tonic-gate=head2 Configuration variables.
251*0Sstevel@tonic-gate
252*0Sstevel@tonic-gateThese variables can be used to configure the behavior of
253*0Sstevel@tonic-gateTest::Harness.  They are exported on request.
254*0Sstevel@tonic-gate
255*0Sstevel@tonic-gate=over 4
256*0Sstevel@tonic-gate
257*0Sstevel@tonic-gate=item B<$Test::Harness::Verbose>
258*0Sstevel@tonic-gate
259*0Sstevel@tonic-gateThe global variable C<$Test::Harness::Verbose> is exportable and can be
260*0Sstevel@tonic-gateused to let C<runtests()> display the standard output of the script
261*0Sstevel@tonic-gatewithout altering the behavior otherwise.  The F<prove> utility's C<-v>
262*0Sstevel@tonic-gateflag will set this.
263*0Sstevel@tonic-gate
264*0Sstevel@tonic-gate=item B<$Test::Harness::switches>
265*0Sstevel@tonic-gate
266*0Sstevel@tonic-gateThe global variable C<$Test::Harness::switches> is exportable and can be
267*0Sstevel@tonic-gateused to set perl command line options used for running the test
268*0Sstevel@tonic-gatescript(s). The default value is C<-w>. It overrides C<HARNESS_SWITCHES>.
269*0Sstevel@tonic-gate
270*0Sstevel@tonic-gate=back
271*0Sstevel@tonic-gate
272*0Sstevel@tonic-gate
273*0Sstevel@tonic-gate=head2 Failure
274*0Sstevel@tonic-gate
275*0Sstevel@tonic-gateIt will happen: your tests will fail.  After you mop up your ego, you
276*0Sstevel@tonic-gatecan begin examining the summary report:
277*0Sstevel@tonic-gate
278*0Sstevel@tonic-gate  t/base..............ok
279*0Sstevel@tonic-gate  t/nonumbers.........ok
280*0Sstevel@tonic-gate  t/ok................ok
281*0Sstevel@tonic-gate  t/test-harness......ok
282*0Sstevel@tonic-gate  t/waterloo..........dubious
283*0Sstevel@tonic-gate          Test returned status 3 (wstat 768, 0x300)
284*0Sstevel@tonic-gate  DIED. FAILED tests 1, 3, 5, 7, 9, 11, 13, 15, 17, 19
285*0Sstevel@tonic-gate          Failed 10/20 tests, 50.00% okay
286*0Sstevel@tonic-gate  Failed Test  Stat Wstat Total Fail  Failed  List of Failed
287*0Sstevel@tonic-gate  -----------------------------------------------------------------------
288*0Sstevel@tonic-gate  t/waterloo.t    3   768    20   10  50.00%  1 3 5 7 9 11 13 15 17 19
289*0Sstevel@tonic-gate  Failed 1/5 test scripts, 80.00% okay. 10/44 subtests failed, 77.27% okay.
290*0Sstevel@tonic-gate
291*0Sstevel@tonic-gateEverything passed but t/waterloo.t.  It failed 10 of 20 tests and
292*0Sstevel@tonic-gateexited with non-zero status indicating something dubious happened.
293*0Sstevel@tonic-gate
294*0Sstevel@tonic-gateThe columns in the summary report mean:
295*0Sstevel@tonic-gate
296*0Sstevel@tonic-gate=over 4
297*0Sstevel@tonic-gate
298*0Sstevel@tonic-gate=item B<Failed Test>
299*0Sstevel@tonic-gate
300*0Sstevel@tonic-gateThe test file which failed.
301*0Sstevel@tonic-gate
302*0Sstevel@tonic-gate=item B<Stat>
303*0Sstevel@tonic-gate
304*0Sstevel@tonic-gateIf the test exited with non-zero, this is its exit status.
305*0Sstevel@tonic-gate
306*0Sstevel@tonic-gate=item B<Wstat>
307*0Sstevel@tonic-gate
308*0Sstevel@tonic-gateThe wait status of the test.
309*0Sstevel@tonic-gate
310*0Sstevel@tonic-gate=item B<Total>
311*0Sstevel@tonic-gate
312*0Sstevel@tonic-gateTotal number of tests expected to run.
313*0Sstevel@tonic-gate
314*0Sstevel@tonic-gate=item B<Fail>
315*0Sstevel@tonic-gate
316*0Sstevel@tonic-gateNumber which failed, either from "not ok" or because they never ran.
317*0Sstevel@tonic-gate
318*0Sstevel@tonic-gate=item B<Failed>
319*0Sstevel@tonic-gate
320*0Sstevel@tonic-gatePercentage of the total tests which failed.
321*0Sstevel@tonic-gate
322*0Sstevel@tonic-gate=item B<List of Failed>
323*0Sstevel@tonic-gate
324*0Sstevel@tonic-gateA list of the tests which failed.  Successive failures may be
325*0Sstevel@tonic-gateabbreviated (ie. 15-20 to indicate that tests 15, 16, 17, 18, 19 and
326*0Sstevel@tonic-gate20 failed).
327*0Sstevel@tonic-gate
328*0Sstevel@tonic-gate=back
329*0Sstevel@tonic-gate
330*0Sstevel@tonic-gate
331*0Sstevel@tonic-gate=head2 Functions
332*0Sstevel@tonic-gate
333*0Sstevel@tonic-gateTest::Harness currently only has one function, here it is.
334*0Sstevel@tonic-gate
335*0Sstevel@tonic-gate=over 4
336*0Sstevel@tonic-gate
337*0Sstevel@tonic-gate=item B<runtests>
338*0Sstevel@tonic-gate
339*0Sstevel@tonic-gate  my $allok = runtests(@test_files);
340*0Sstevel@tonic-gate
341*0Sstevel@tonic-gateThis runs all the given @test_files and divines whether they passed
342*0Sstevel@tonic-gateor failed based on their output to STDOUT (details above).  It prints
343*0Sstevel@tonic-gateout each individual test which failed along with a summary report and
344*0Sstevel@tonic-gatea how long it all took.
345*0Sstevel@tonic-gate
346*0Sstevel@tonic-gateIt returns true if everything was ok.  Otherwise it will die() with
347*0Sstevel@tonic-gateone of the messages in the DIAGNOSTICS section.
348*0Sstevel@tonic-gate
349*0Sstevel@tonic-gate=for _private
350*0Sstevel@tonic-gate
351*0Sstevel@tonic-gateThis is just _run_all_tests() plus _show_results()
352*0Sstevel@tonic-gate
353*0Sstevel@tonic-gate=cut
354*0Sstevel@tonic-gate
355*0Sstevel@tonic-gatesub runtests {
356*0Sstevel@tonic-gate    my(@tests) = @_;
357*0Sstevel@tonic-gate
358*0Sstevel@tonic-gate    local ($\, $,);
359*0Sstevel@tonic-gate
360*0Sstevel@tonic-gate    my($tot, $failedtests) = _run_all_tests(@tests);
361*0Sstevel@tonic-gate    _show_results($tot, $failedtests);
362*0Sstevel@tonic-gate
363*0Sstevel@tonic-gate    my $ok = _all_ok($tot);
364*0Sstevel@tonic-gate
365*0Sstevel@tonic-gate    assert(($ok xor keys %$failedtests),
366*0Sstevel@tonic-gate           q{ok status jives with $failedtests});
367*0Sstevel@tonic-gate
368*0Sstevel@tonic-gate    return $ok;
369*0Sstevel@tonic-gate}
370*0Sstevel@tonic-gate
371*0Sstevel@tonic-gate=begin _private
372*0Sstevel@tonic-gate
373*0Sstevel@tonic-gate=item B<_all_ok>
374*0Sstevel@tonic-gate
375*0Sstevel@tonic-gate  my $ok = _all_ok(\%tot);
376*0Sstevel@tonic-gate
377*0Sstevel@tonic-gateTells you if this test run is overall successful or not.
378*0Sstevel@tonic-gate
379*0Sstevel@tonic-gate=cut
380*0Sstevel@tonic-gate
381*0Sstevel@tonic-gatesub _all_ok {
382*0Sstevel@tonic-gate    my($tot) = shift;
383*0Sstevel@tonic-gate
384*0Sstevel@tonic-gate    return $tot->{bad} == 0 && ($tot->{max} || $tot->{skipped}) ? 1 : 0;
385*0Sstevel@tonic-gate}
386*0Sstevel@tonic-gate
387*0Sstevel@tonic-gate=item B<_globdir>
388*0Sstevel@tonic-gate
389*0Sstevel@tonic-gate  my @files = _globdir $dir;
390*0Sstevel@tonic-gate
391*0Sstevel@tonic-gateReturns all the files in a directory.  This is shorthand for backwards
392*0Sstevel@tonic-gatecompatibility on systems where glob() doesn't work right.
393*0Sstevel@tonic-gate
394*0Sstevel@tonic-gate=cut
395*0Sstevel@tonic-gate
396*0Sstevel@tonic-gatesub _globdir {
397*0Sstevel@tonic-gate    opendir DIRH, shift;
398*0Sstevel@tonic-gate    my @f = readdir DIRH;
399*0Sstevel@tonic-gate    closedir DIRH;
400*0Sstevel@tonic-gate
401*0Sstevel@tonic-gate    return @f;
402*0Sstevel@tonic-gate}
403*0Sstevel@tonic-gate
404*0Sstevel@tonic-gate=item B<_run_all_tests>
405*0Sstevel@tonic-gate
406*0Sstevel@tonic-gate  my($total, $failed) = _run_all_tests(@test_files);
407*0Sstevel@tonic-gate
408*0Sstevel@tonic-gateRuns all the given C<@test_files> (as C<runtests()>) but does it
409*0Sstevel@tonic-gatequietly (no report).  $total is a hash ref summary of all the tests
410*0Sstevel@tonic-gaterun.  Its keys and values are this:
411*0Sstevel@tonic-gate
412*0Sstevel@tonic-gate    bonus           Number of individual todo tests unexpectedly passed
413*0Sstevel@tonic-gate    max             Number of individual tests ran
414*0Sstevel@tonic-gate    ok              Number of individual tests passed
415*0Sstevel@tonic-gate    sub_skipped     Number of individual tests skipped
416*0Sstevel@tonic-gate    todo            Number of individual todo tests
417*0Sstevel@tonic-gate
418*0Sstevel@tonic-gate    files           Number of test files ran
419*0Sstevel@tonic-gate    good            Number of test files passed
420*0Sstevel@tonic-gate    bad             Number of test files failed
421*0Sstevel@tonic-gate    tests           Number of test files originally given
422*0Sstevel@tonic-gate    skipped         Number of test files skipped
423*0Sstevel@tonic-gate
424*0Sstevel@tonic-gateIf C<< $total->{bad} == 0 >> and C<< $total->{max} > 0 >>, you've
425*0Sstevel@tonic-gategot a successful test.
426*0Sstevel@tonic-gate
427*0Sstevel@tonic-gate$failed is a hash ref of all the test scripts which failed.  Each key
428*0Sstevel@tonic-gateis the name of a test script, each value is another hash representing
429*0Sstevel@tonic-gatehow that script failed.  Its keys are these:
430*0Sstevel@tonic-gate
431*0Sstevel@tonic-gate    name        Name of the test which failed
432*0Sstevel@tonic-gate    estat       Script's exit value
433*0Sstevel@tonic-gate    wstat       Script's wait status
434*0Sstevel@tonic-gate    max         Number of individual tests
435*0Sstevel@tonic-gate    failed      Number which failed
436*0Sstevel@tonic-gate    percent     Percentage of tests which failed
437*0Sstevel@tonic-gate    canon       List of tests which failed (as string).
438*0Sstevel@tonic-gate
439*0Sstevel@tonic-gateC<$failed> should be empty if everything passed.
440*0Sstevel@tonic-gate
441*0Sstevel@tonic-gateB<NOTE> Currently this function is still noisy.  I'm working on it.
442*0Sstevel@tonic-gate
443*0Sstevel@tonic-gate=cut
444*0Sstevel@tonic-gate
445*0Sstevel@tonic-gate#'#
446*0Sstevel@tonic-gatesub _run_all_tests {
447*0Sstevel@tonic-gate    my(@tests) = @_;
448*0Sstevel@tonic-gate    local($|) = 1;
449*0Sstevel@tonic-gate    my(%failedtests);
450*0Sstevel@tonic-gate
451*0Sstevel@tonic-gate    # Test-wide totals.
452*0Sstevel@tonic-gate    my(%tot) = (
453*0Sstevel@tonic-gate                bonus    => 0,
454*0Sstevel@tonic-gate                max      => 0,
455*0Sstevel@tonic-gate                ok       => 0,
456*0Sstevel@tonic-gate                files    => 0,
457*0Sstevel@tonic-gate                bad      => 0,
458*0Sstevel@tonic-gate                good     => 0,
459*0Sstevel@tonic-gate                tests    => scalar @tests,
460*0Sstevel@tonic-gate                sub_skipped  => 0,
461*0Sstevel@tonic-gate                todo     => 0,
462*0Sstevel@tonic-gate                skipped  => 0,
463*0Sstevel@tonic-gate                bench    => 0,
464*0Sstevel@tonic-gate               );
465*0Sstevel@tonic-gate
466*0Sstevel@tonic-gate    my @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
467*0Sstevel@tonic-gate    my $t_start = new Benchmark;
468*0Sstevel@tonic-gate
469*0Sstevel@tonic-gate    my $width = _leader_width(@tests);
470*0Sstevel@tonic-gate    foreach my $tfile (@tests) {
471*0Sstevel@tonic-gate	if ( $Test::Harness::Debug ) {
472*0Sstevel@tonic-gate	    print "# Running: ", $Strap->_command_line($tfile), "\n";
473*0Sstevel@tonic-gate	}
474*0Sstevel@tonic-gate
475*0Sstevel@tonic-gate        $Last_ML_Print = 0;  # so each test prints at least once
476*0Sstevel@tonic-gate        my($leader, $ml) = _mk_leader($tfile, $width);
477*0Sstevel@tonic-gate        local $ML = $ml;
478*0Sstevel@tonic-gate
479*0Sstevel@tonic-gate        print $leader;
480*0Sstevel@tonic-gate
481*0Sstevel@tonic-gate        $tot{files}++;
482*0Sstevel@tonic-gate
483*0Sstevel@tonic-gate        $Strap->{_seen_header} = 0;
484*0Sstevel@tonic-gate        my %results = $Strap->analyze_file($tfile) or
485*0Sstevel@tonic-gate          do { warn $Strap->{error}, "\n";  next };
486*0Sstevel@tonic-gate
487*0Sstevel@tonic-gate        # state of the current test.
488*0Sstevel@tonic-gate        my @failed = grep { !$results{details}[$_-1]{ok} }
489*0Sstevel@tonic-gate                     1..@{$results{details}};
490*0Sstevel@tonic-gate        my %test = (
491*0Sstevel@tonic-gate                    ok          => $results{ok},
492*0Sstevel@tonic-gate                    'next'      => $Strap->{'next'},
493*0Sstevel@tonic-gate                    max         => $results{max},
494*0Sstevel@tonic-gate                    failed      => \@failed,
495*0Sstevel@tonic-gate                    bonus       => $results{bonus},
496*0Sstevel@tonic-gate                    skipped     => $results{skip},
497*0Sstevel@tonic-gate                    skip_reason => $results{skip_reason},
498*0Sstevel@tonic-gate                    skip_all    => $Strap->{skip_all},
499*0Sstevel@tonic-gate                    ml          => $ml,
500*0Sstevel@tonic-gate                   );
501*0Sstevel@tonic-gate
502*0Sstevel@tonic-gate        $tot{bonus}       += $results{bonus};
503*0Sstevel@tonic-gate        $tot{max}         += $results{max};
504*0Sstevel@tonic-gate        $tot{ok}          += $results{ok};
505*0Sstevel@tonic-gate        $tot{todo}        += $results{todo};
506*0Sstevel@tonic-gate        $tot{sub_skipped} += $results{skip};
507*0Sstevel@tonic-gate
508*0Sstevel@tonic-gate        my($estatus, $wstatus) = @results{qw(exit wait)};
509*0Sstevel@tonic-gate
510*0Sstevel@tonic-gate        if ($results{passing}) {
511*0Sstevel@tonic-gate            if ($test{max} and $test{skipped} + $test{bonus}) {
512*0Sstevel@tonic-gate                my @msg;
513*0Sstevel@tonic-gate                push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")
514*0Sstevel@tonic-gate                    if $test{skipped};
515*0Sstevel@tonic-gate                push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded")
516*0Sstevel@tonic-gate                    if $test{bonus};
517*0Sstevel@tonic-gate                print "$test{ml}ok\n        ".join(', ', @msg)."\n";
518*0Sstevel@tonic-gate            } elsif ($test{max}) {
519*0Sstevel@tonic-gate                print "$test{ml}ok\n";
520*0Sstevel@tonic-gate            } elsif (defined $test{skip_all} and length $test{skip_all}) {
521*0Sstevel@tonic-gate                print "skipped\n        all skipped: $test{skip_all}\n";
522*0Sstevel@tonic-gate                $tot{skipped}++;
523*0Sstevel@tonic-gate            } else {
524*0Sstevel@tonic-gate                print "skipped\n        all skipped: no reason given\n";
525*0Sstevel@tonic-gate                $tot{skipped}++;
526*0Sstevel@tonic-gate            }
527*0Sstevel@tonic-gate            $tot{good}++;
528*0Sstevel@tonic-gate        }
529*0Sstevel@tonic-gate        else {
530*0Sstevel@tonic-gate            # List unrun tests as failures.
531*0Sstevel@tonic-gate            if ($test{'next'} <= $test{max}) {
532*0Sstevel@tonic-gate                push @{$test{failed}}, $test{'next'}..$test{max};
533*0Sstevel@tonic-gate            }
534*0Sstevel@tonic-gate            # List overruns as failures.
535*0Sstevel@tonic-gate            else {
536*0Sstevel@tonic-gate                my $details = $results{details};
537*0Sstevel@tonic-gate                foreach my $overrun ($test{max}+1..@$details)
538*0Sstevel@tonic-gate                {
539*0Sstevel@tonic-gate                    next unless ref $details->[$overrun-1];
540*0Sstevel@tonic-gate                    push @{$test{failed}}, $overrun
541*0Sstevel@tonic-gate                }
542*0Sstevel@tonic-gate            }
543*0Sstevel@tonic-gate
544*0Sstevel@tonic-gate            if ($wstatus) {
545*0Sstevel@tonic-gate                $failedtests{$tfile} = _dubious_return(\%test, \%tot,
546*0Sstevel@tonic-gate                                                       $estatus, $wstatus);
547*0Sstevel@tonic-gate                $failedtests{$tfile}{name} = $tfile;
548*0Sstevel@tonic-gate            }
549*0Sstevel@tonic-gate            elsif($results{seen}) {
550*0Sstevel@tonic-gate                if (@{$test{failed}} and $test{max}) {
551*0Sstevel@tonic-gate                    my ($txt, $canon) = _canonfailed($test{max},$test{skipped},
552*0Sstevel@tonic-gate                                                    @{$test{failed}});
553*0Sstevel@tonic-gate                    print "$test{ml}$txt";
554*0Sstevel@tonic-gate                    $failedtests{$tfile} = { canon   => $canon,
555*0Sstevel@tonic-gate                                             max     => $test{max},
556*0Sstevel@tonic-gate                                             failed  => scalar @{$test{failed}},
557*0Sstevel@tonic-gate                                             name    => $tfile,
558*0Sstevel@tonic-gate                                             percent => 100*(scalar @{$test{failed}})/$test{max},
559*0Sstevel@tonic-gate                                             estat   => '',
560*0Sstevel@tonic-gate                                             wstat   => '',
561*0Sstevel@tonic-gate                                           };
562*0Sstevel@tonic-gate                } else {
563*0Sstevel@tonic-gate                    print "Don't know which tests failed: got $test{ok} ok, ".
564*0Sstevel@tonic-gate                          "expected $test{max}\n";
565*0Sstevel@tonic-gate                    $failedtests{$tfile} = { canon   => '??',
566*0Sstevel@tonic-gate                                             max     => $test{max},
567*0Sstevel@tonic-gate                                             failed  => '??',
568*0Sstevel@tonic-gate                                             name    => $tfile,
569*0Sstevel@tonic-gate                                             percent => undef,
570*0Sstevel@tonic-gate                                             estat   => '',
571*0Sstevel@tonic-gate                                             wstat   => '',
572*0Sstevel@tonic-gate                                           };
573*0Sstevel@tonic-gate                }
574*0Sstevel@tonic-gate                $tot{bad}++;
575*0Sstevel@tonic-gate            } else {
576*0Sstevel@tonic-gate                print "FAILED before any test output arrived\n";
577*0Sstevel@tonic-gate                $tot{bad}++;
578*0Sstevel@tonic-gate                $failedtests{$tfile} = { canon       => '??',
579*0Sstevel@tonic-gate                                         max         => '??',
580*0Sstevel@tonic-gate                                         failed      => '??',
581*0Sstevel@tonic-gate                                         name        => $tfile,
582*0Sstevel@tonic-gate                                         percent     => undef,
583*0Sstevel@tonic-gate                                         estat       => '',
584*0Sstevel@tonic-gate                                         wstat       => '',
585*0Sstevel@tonic-gate                                       };
586*0Sstevel@tonic-gate            }
587*0Sstevel@tonic-gate        }
588*0Sstevel@tonic-gate
589*0Sstevel@tonic-gate        if (defined $Files_In_Dir) {
590*0Sstevel@tonic-gate            my @new_dir_files = _globdir $Files_In_Dir;
591*0Sstevel@tonic-gate            if (@new_dir_files != @dir_files) {
592*0Sstevel@tonic-gate                my %f;
593*0Sstevel@tonic-gate                @f{@new_dir_files} = (1) x @new_dir_files;
594*0Sstevel@tonic-gate                delete @f{@dir_files};
595*0Sstevel@tonic-gate                my @f = sort keys %f;
596*0Sstevel@tonic-gate                print "LEAKED FILES: @f\n";
597*0Sstevel@tonic-gate                @dir_files = @new_dir_files;
598*0Sstevel@tonic-gate            }
599*0Sstevel@tonic-gate        }
600*0Sstevel@tonic-gate    }
601*0Sstevel@tonic-gate    $tot{bench} = timediff(new Benchmark, $t_start);
602*0Sstevel@tonic-gate
603*0Sstevel@tonic-gate    $Strap->_restore_PERL5LIB;
604*0Sstevel@tonic-gate
605*0Sstevel@tonic-gate    return(\%tot, \%failedtests);
606*0Sstevel@tonic-gate}
607*0Sstevel@tonic-gate
608*0Sstevel@tonic-gate=item B<_mk_leader>
609*0Sstevel@tonic-gate
610*0Sstevel@tonic-gate  my($leader, $ml) = _mk_leader($test_file, $width);
611*0Sstevel@tonic-gate
612*0Sstevel@tonic-gateGenerates the 't/foo........' $leader for the given C<$test_file> as well
613*0Sstevel@tonic-gateas a similar version which will overwrite the current line (by use of
614*0Sstevel@tonic-gate\r and such).  C<$ml> may be empty if Test::Harness doesn't think you're
615*0Sstevel@tonic-gateon TTY.
616*0Sstevel@tonic-gate
617*0Sstevel@tonic-gateThe C<$width> is the width of the "yada/blah.." string.
618*0Sstevel@tonic-gate
619*0Sstevel@tonic-gate=cut
620*0Sstevel@tonic-gate
621*0Sstevel@tonic-gatesub _mk_leader {
622*0Sstevel@tonic-gate    my($te, $width) = @_;
623*0Sstevel@tonic-gate    chomp($te);
624*0Sstevel@tonic-gate    $te =~ s/\.\w+$/./;
625*0Sstevel@tonic-gate
626*0Sstevel@tonic-gate    if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; }
627*0Sstevel@tonic-gate    my $blank = (' ' x 77);
628*0Sstevel@tonic-gate    my $leader = "$te" . '.' x ($width - length($te));
629*0Sstevel@tonic-gate    my $ml = "";
630*0Sstevel@tonic-gate
631*0Sstevel@tonic-gate    $ml = "\r$blank\r$leader"
632*0Sstevel@tonic-gate      if -t STDOUT and not $ENV{HARNESS_NOTTY} and not $Verbose;
633*0Sstevel@tonic-gate
634*0Sstevel@tonic-gate    return($leader, $ml);
635*0Sstevel@tonic-gate}
636*0Sstevel@tonic-gate
637*0Sstevel@tonic-gate=item B<_leader_width>
638*0Sstevel@tonic-gate
639*0Sstevel@tonic-gate  my($width) = _leader_width(@test_files);
640*0Sstevel@tonic-gate
641*0Sstevel@tonic-gateCalculates how wide the leader should be based on the length of the
642*0Sstevel@tonic-gatelongest test name.
643*0Sstevel@tonic-gate
644*0Sstevel@tonic-gate=cut
645*0Sstevel@tonic-gate
646*0Sstevel@tonic-gatesub _leader_width {
647*0Sstevel@tonic-gate    my $maxlen = 0;
648*0Sstevel@tonic-gate    my $maxsuflen = 0;
649*0Sstevel@tonic-gate    foreach (@_) {
650*0Sstevel@tonic-gate        my $suf    = /\.(\w+)$/ ? $1 : '';
651*0Sstevel@tonic-gate        my $len    = length;
652*0Sstevel@tonic-gate        my $suflen = length $suf;
653*0Sstevel@tonic-gate        $maxlen    = $len    if $len    > $maxlen;
654*0Sstevel@tonic-gate        $maxsuflen = $suflen if $suflen > $maxsuflen;
655*0Sstevel@tonic-gate    }
656*0Sstevel@tonic-gate    # + 3 : we want three dots between the test name and the "ok"
657*0Sstevel@tonic-gate    return $maxlen + 3 - $maxsuflen;
658*0Sstevel@tonic-gate}
659*0Sstevel@tonic-gate
660*0Sstevel@tonic-gate
661*0Sstevel@tonic-gatesub _show_results {
662*0Sstevel@tonic-gate    my($tot, $failedtests) = @_;
663*0Sstevel@tonic-gate
664*0Sstevel@tonic-gate    my $pct;
665*0Sstevel@tonic-gate    my $bonusmsg = _bonusmsg($tot);
666*0Sstevel@tonic-gate
667*0Sstevel@tonic-gate    if (_all_ok($tot)) {
668*0Sstevel@tonic-gate        print "All tests successful$bonusmsg.\n";
669*0Sstevel@tonic-gate    } elsif (!$tot->{tests}){
670*0Sstevel@tonic-gate        die "FAILED--no tests were run for some reason.\n";
671*0Sstevel@tonic-gate    } elsif (!$tot->{max}) {
672*0Sstevel@tonic-gate        my $blurb = $tot->{tests}==1 ? "script" : "scripts";
673*0Sstevel@tonic-gate        die "FAILED--$tot->{tests} test $blurb could be run, ".
674*0Sstevel@tonic-gate            "alas--no output ever seen\n";
675*0Sstevel@tonic-gate    } else {
676*0Sstevel@tonic-gate        $pct = sprintf("%.2f", $tot->{good} / $tot->{tests} * 100);
677*0Sstevel@tonic-gate        my $percent_ok = 100*$tot->{ok}/$tot->{max};
678*0Sstevel@tonic-gate        my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
679*0Sstevel@tonic-gate                              $tot->{max} - $tot->{ok}, $tot->{max},
680*0Sstevel@tonic-gate                              $percent_ok;
681*0Sstevel@tonic-gate
682*0Sstevel@tonic-gate        my($fmt_top, $fmt) = _create_fmts($failedtests);
683*0Sstevel@tonic-gate
684*0Sstevel@tonic-gate        # Now write to formats
685*0Sstevel@tonic-gate        for my $script (sort keys %$failedtests) {
686*0Sstevel@tonic-gate          $Curtest = $failedtests->{$script};
687*0Sstevel@tonic-gate          write;
688*0Sstevel@tonic-gate        }
689*0Sstevel@tonic-gate        if ($tot->{bad}) {
690*0Sstevel@tonic-gate            $bonusmsg =~ s/^,\s*//;
691*0Sstevel@tonic-gate            print "$bonusmsg.\n" if $bonusmsg;
692*0Sstevel@tonic-gate            die "Failed $tot->{bad}/$tot->{tests} test scripts, $pct% okay.".
693*0Sstevel@tonic-gate                "$subpct\n";
694*0Sstevel@tonic-gate        }
695*0Sstevel@tonic-gate    }
696*0Sstevel@tonic-gate
697*0Sstevel@tonic-gate    printf("Files=%d, Tests=%d, %s\n",
698*0Sstevel@tonic-gate           $tot->{files}, $tot->{max}, timestr($tot->{bench}, 'nop'));
699*0Sstevel@tonic-gate}
700*0Sstevel@tonic-gate
701*0Sstevel@tonic-gate
702*0Sstevel@tonic-gatemy %Handlers = ();
703*0Sstevel@tonic-gate$Strap->{callback} = sub {
704*0Sstevel@tonic-gate    my($self, $line, $type, $totals) = @_;
705*0Sstevel@tonic-gate    print $line if $Verbose;
706*0Sstevel@tonic-gate
707*0Sstevel@tonic-gate    my $meth = $Handlers{$type};
708*0Sstevel@tonic-gate    $meth->($self, $line, $type, $totals) if $meth;
709*0Sstevel@tonic-gate};
710*0Sstevel@tonic-gate
711*0Sstevel@tonic-gate
712*0Sstevel@tonic-gate$Handlers{header} = sub {
713*0Sstevel@tonic-gate    my($self, $line, $type, $totals) = @_;
714*0Sstevel@tonic-gate
715*0Sstevel@tonic-gate    warn "Test header seen more than once!\n" if $self->{_seen_header};
716*0Sstevel@tonic-gate
717*0Sstevel@tonic-gate    $self->{_seen_header}++;
718*0Sstevel@tonic-gate
719*0Sstevel@tonic-gate    warn "1..M can only appear at the beginning or end of tests\n"
720*0Sstevel@tonic-gate      if $totals->{seen} &&
721*0Sstevel@tonic-gate         $totals->{max}  < $totals->{seen};
722*0Sstevel@tonic-gate};
723*0Sstevel@tonic-gate
724*0Sstevel@tonic-gate$Handlers{test} = sub {
725*0Sstevel@tonic-gate    my($self, $line, $type, $totals) = @_;
726*0Sstevel@tonic-gate
727*0Sstevel@tonic-gate    my $curr = $totals->{seen};
728*0Sstevel@tonic-gate    my $next = $self->{'next'};
729*0Sstevel@tonic-gate    my $max  = $totals->{max};
730*0Sstevel@tonic-gate    my $detail = $totals->{details}[-1];
731*0Sstevel@tonic-gate
732*0Sstevel@tonic-gate    if( $detail->{ok} ) {
733*0Sstevel@tonic-gate        _print_ml_less("ok $curr/$max");
734*0Sstevel@tonic-gate
735*0Sstevel@tonic-gate        if( $detail->{type} eq 'skip' ) {
736*0Sstevel@tonic-gate            $totals->{skip_reason} = $detail->{reason}
737*0Sstevel@tonic-gate              unless defined $totals->{skip_reason};
738*0Sstevel@tonic-gate            $totals->{skip_reason} = 'various reasons'
739*0Sstevel@tonic-gate              if $totals->{skip_reason} ne $detail->{reason};
740*0Sstevel@tonic-gate        }
741*0Sstevel@tonic-gate    }
742*0Sstevel@tonic-gate    else {
743*0Sstevel@tonic-gate        _print_ml("NOK $curr");
744*0Sstevel@tonic-gate    }
745*0Sstevel@tonic-gate
746*0Sstevel@tonic-gate    if( $curr > $next ) {
747*0Sstevel@tonic-gate        print "Test output counter mismatch [test $curr]\n";
748*0Sstevel@tonic-gate    }
749*0Sstevel@tonic-gate    elsif( $curr < $next ) {
750*0Sstevel@tonic-gate        print "Confused test output: test $curr answered after ".
751*0Sstevel@tonic-gate              "test ", $next - 1, "\n";
752*0Sstevel@tonic-gate    }
753*0Sstevel@tonic-gate
754*0Sstevel@tonic-gate};
755*0Sstevel@tonic-gate
756*0Sstevel@tonic-gate$Handlers{bailout} = sub {
757*0Sstevel@tonic-gate    my($self, $line, $type, $totals) = @_;
758*0Sstevel@tonic-gate
759*0Sstevel@tonic-gate    die "FAILED--Further testing stopped" .
760*0Sstevel@tonic-gate      ($self->{bailout_reason} ? ": $self->{bailout_reason}\n" : ".\n");
761*0Sstevel@tonic-gate};
762*0Sstevel@tonic-gate
763*0Sstevel@tonic-gate
764*0Sstevel@tonic-gatesub _print_ml {
765*0Sstevel@tonic-gate    print join '', $ML, @_ if $ML;
766*0Sstevel@tonic-gate}
767*0Sstevel@tonic-gate
768*0Sstevel@tonic-gate
769*0Sstevel@tonic-gate# For slow connections, we save lots of bandwidth by printing only once
770*0Sstevel@tonic-gate# per second.
771*0Sstevel@tonic-gatesub _print_ml_less {
772*0Sstevel@tonic-gate    if( !$Ok_Slow || $Last_ML_Print != time ) {
773*0Sstevel@tonic-gate        _print_ml(@_);
774*0Sstevel@tonic-gate        $Last_ML_Print = time;
775*0Sstevel@tonic-gate    }
776*0Sstevel@tonic-gate}
777*0Sstevel@tonic-gate
778*0Sstevel@tonic-gatesub _bonusmsg {
779*0Sstevel@tonic-gate    my($tot) = @_;
780*0Sstevel@tonic-gate
781*0Sstevel@tonic-gate    my $bonusmsg = '';
782*0Sstevel@tonic-gate    $bonusmsg = (" ($tot->{bonus} subtest".($tot->{bonus} > 1 ? 's' : '').
783*0Sstevel@tonic-gate               " UNEXPECTEDLY SUCCEEDED)")
784*0Sstevel@tonic-gate        if $tot->{bonus};
785*0Sstevel@tonic-gate
786*0Sstevel@tonic-gate    if ($tot->{skipped}) {
787*0Sstevel@tonic-gate        $bonusmsg .= ", $tot->{skipped} test"
788*0Sstevel@tonic-gate                     . ($tot->{skipped} != 1 ? 's' : '');
789*0Sstevel@tonic-gate        if ($tot->{sub_skipped}) {
790*0Sstevel@tonic-gate            $bonusmsg .= " and $tot->{sub_skipped} subtest"
791*0Sstevel@tonic-gate                         . ($tot->{sub_skipped} != 1 ? 's' : '');
792*0Sstevel@tonic-gate        }
793*0Sstevel@tonic-gate        $bonusmsg .= ' skipped';
794*0Sstevel@tonic-gate    }
795*0Sstevel@tonic-gate    elsif ($tot->{sub_skipped}) {
796*0Sstevel@tonic-gate        $bonusmsg .= ", $tot->{sub_skipped} subtest"
797*0Sstevel@tonic-gate                     . ($tot->{sub_skipped} != 1 ? 's' : '')
798*0Sstevel@tonic-gate                     . " skipped";
799*0Sstevel@tonic-gate    }
800*0Sstevel@tonic-gate
801*0Sstevel@tonic-gate    return $bonusmsg;
802*0Sstevel@tonic-gate}
803*0Sstevel@tonic-gate
804*0Sstevel@tonic-gate# Test program go boom.
805*0Sstevel@tonic-gatesub _dubious_return {
806*0Sstevel@tonic-gate    my($test, $tot, $estatus, $wstatus) = @_;
807*0Sstevel@tonic-gate    my ($failed, $canon, $percent) = ('??', '??');
808*0Sstevel@tonic-gate
809*0Sstevel@tonic-gate    printf "$test->{ml}dubious\n\tTest returned status $estatus ".
810*0Sstevel@tonic-gate           "(wstat %d, 0x%x)\n",
811*0Sstevel@tonic-gate           $wstatus,$wstatus;
812*0Sstevel@tonic-gate    print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
813*0Sstevel@tonic-gate
814*0Sstevel@tonic-gate    if (_corestatus($wstatus)) { # until we have a wait module
815*0Sstevel@tonic-gate        if ($Have_Devel_Corestack) {
816*0Sstevel@tonic-gate            Devel::CoreStack::stack($^X);
817*0Sstevel@tonic-gate        } else {
818*0Sstevel@tonic-gate            print "\ttest program seems to have generated a core\n";
819*0Sstevel@tonic-gate        }
820*0Sstevel@tonic-gate    }
821*0Sstevel@tonic-gate
822*0Sstevel@tonic-gate    $tot->{bad}++;
823*0Sstevel@tonic-gate
824*0Sstevel@tonic-gate    if ($test->{max}) {
825*0Sstevel@tonic-gate        if ($test->{'next'} == $test->{max} + 1 and not @{$test->{failed}}) {
826*0Sstevel@tonic-gate            print "\tafter all the subtests completed successfully\n";
827*0Sstevel@tonic-gate            $percent = 0;
828*0Sstevel@tonic-gate            $failed = 0;        # But we do not set $canon!
829*0Sstevel@tonic-gate        }
830*0Sstevel@tonic-gate        else {
831*0Sstevel@tonic-gate            push @{$test->{failed}}, $test->{'next'}..$test->{max};
832*0Sstevel@tonic-gate            $failed = @{$test->{failed}};
833*0Sstevel@tonic-gate            (my $txt, $canon) = _canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
834*0Sstevel@tonic-gate            $percent = 100*(scalar @{$test->{failed}})/$test->{max};
835*0Sstevel@tonic-gate            print "DIED. ",$txt;
836*0Sstevel@tonic-gate        }
837*0Sstevel@tonic-gate    }
838*0Sstevel@tonic-gate
839*0Sstevel@tonic-gate    return { canon => $canon,  max => $test->{max} || '??',
840*0Sstevel@tonic-gate             failed => $failed,
841*0Sstevel@tonic-gate             percent => $percent,
842*0Sstevel@tonic-gate             estat => $estatus, wstat => $wstatus,
843*0Sstevel@tonic-gate           };
844*0Sstevel@tonic-gate}
845*0Sstevel@tonic-gate
846*0Sstevel@tonic-gate
847*0Sstevel@tonic-gatesub _create_fmts {
848*0Sstevel@tonic-gate    my($failedtests) = @_;
849*0Sstevel@tonic-gate
850*0Sstevel@tonic-gate    my $failed_str = "Failed Test";
851*0Sstevel@tonic-gate    my $middle_str = " Stat Wstat Total Fail  Failed  ";
852*0Sstevel@tonic-gate    my $list_str = "List of Failed";
853*0Sstevel@tonic-gate
854*0Sstevel@tonic-gate    # Figure out our longest name string for formatting purposes.
855*0Sstevel@tonic-gate    my $max_namelen = length($failed_str);
856*0Sstevel@tonic-gate    foreach my $script (keys %$failedtests) {
857*0Sstevel@tonic-gate        my $namelen = length $failedtests->{$script}->{name};
858*0Sstevel@tonic-gate        $max_namelen = $namelen if $namelen > $max_namelen;
859*0Sstevel@tonic-gate    }
860*0Sstevel@tonic-gate
861*0Sstevel@tonic-gate    my $list_len = $Columns - length($middle_str) - $max_namelen;
862*0Sstevel@tonic-gate    if ($list_len < length($list_str)) {
863*0Sstevel@tonic-gate        $list_len = length($list_str);
864*0Sstevel@tonic-gate        $max_namelen = $Columns - length($middle_str) - $list_len;
865*0Sstevel@tonic-gate        if ($max_namelen < length($failed_str)) {
866*0Sstevel@tonic-gate            $max_namelen = length($failed_str);
867*0Sstevel@tonic-gate            $Columns = $max_namelen + length($middle_str) + $list_len;
868*0Sstevel@tonic-gate        }
869*0Sstevel@tonic-gate    }
870*0Sstevel@tonic-gate
871*0Sstevel@tonic-gate    my $fmt_top = "format STDOUT_TOP =\n"
872*0Sstevel@tonic-gate                  . sprintf("%-${max_namelen}s", $failed_str)
873*0Sstevel@tonic-gate                  . $middle_str
874*0Sstevel@tonic-gate                  . $list_str . "\n"
875*0Sstevel@tonic-gate                  . "-" x $Columns
876*0Sstevel@tonic-gate                  . "\n.\n";
877*0Sstevel@tonic-gate
878*0Sstevel@tonic-gate    my $fmt = "format STDOUT =\n"
879*0Sstevel@tonic-gate              . "@" . "<" x ($max_namelen - 1)
880*0Sstevel@tonic-gate              . "  @>> @>>>> @>>>> @>>> ^##.##%  "
881*0Sstevel@tonic-gate              . "^" . "<" x ($list_len - 1) . "\n"
882*0Sstevel@tonic-gate              . '{ $Curtest->{name}, $Curtest->{estat},'
883*0Sstevel@tonic-gate              . '  $Curtest->{wstat}, $Curtest->{max},'
884*0Sstevel@tonic-gate              . '  $Curtest->{failed}, $Curtest->{percent},'
885*0Sstevel@tonic-gate              . '  $Curtest->{canon}'
886*0Sstevel@tonic-gate              . "\n}\n"
887*0Sstevel@tonic-gate              . "~~" . " " x ($Columns - $list_len - 2) . "^"
888*0Sstevel@tonic-gate              . "<" x ($list_len - 1) . "\n"
889*0Sstevel@tonic-gate              . '$Curtest->{canon}'
890*0Sstevel@tonic-gate              . "\n.\n";
891*0Sstevel@tonic-gate
892*0Sstevel@tonic-gate    eval $fmt_top;
893*0Sstevel@tonic-gate    die $@ if $@;
894*0Sstevel@tonic-gate    eval $fmt;
895*0Sstevel@tonic-gate    die $@ if $@;
896*0Sstevel@tonic-gate
897*0Sstevel@tonic-gate    return($fmt_top, $fmt);
898*0Sstevel@tonic-gate}
899*0Sstevel@tonic-gate
900*0Sstevel@tonic-gate{
901*0Sstevel@tonic-gate    my $tried_devel_corestack;
902*0Sstevel@tonic-gate
903*0Sstevel@tonic-gate    sub _corestatus {
904*0Sstevel@tonic-gate        my($st) = @_;
905*0Sstevel@tonic-gate
906*0Sstevel@tonic-gate        my $did_core;
907*0Sstevel@tonic-gate        eval { # we may not have a WCOREDUMP
908*0Sstevel@tonic-gate            local $^W = 0;  # *.ph files are often *very* noisy
909*0Sstevel@tonic-gate            require 'wait.ph';
910*0Sstevel@tonic-gate            $did_core = WCOREDUMP($st);
911*0Sstevel@tonic-gate        };
912*0Sstevel@tonic-gate        if( $@ ) {
913*0Sstevel@tonic-gate            $did_core = $st & 0200;
914*0Sstevel@tonic-gate        }
915*0Sstevel@tonic-gate
916*0Sstevel@tonic-gate        eval { require Devel::CoreStack; $Have_Devel_Corestack++ }
917*0Sstevel@tonic-gate          unless $tried_devel_corestack++;
918*0Sstevel@tonic-gate
919*0Sstevel@tonic-gate        return $did_core;
920*0Sstevel@tonic-gate    }
921*0Sstevel@tonic-gate}
922*0Sstevel@tonic-gate
923*0Sstevel@tonic-gatesub _canonfailed ($$@) {
924*0Sstevel@tonic-gate    my($max,$skipped,@failed) = @_;
925*0Sstevel@tonic-gate    my %seen;
926*0Sstevel@tonic-gate    @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
927*0Sstevel@tonic-gate    my $failed = @failed;
928*0Sstevel@tonic-gate    my @result = ();
929*0Sstevel@tonic-gate    my @canon = ();
930*0Sstevel@tonic-gate    my $min;
931*0Sstevel@tonic-gate    my $last = $min = shift @failed;
932*0Sstevel@tonic-gate    my $canon;
933*0Sstevel@tonic-gate    if (@failed) {
934*0Sstevel@tonic-gate        for (@failed, $failed[-1]) { # don't forget the last one
935*0Sstevel@tonic-gate            if ($_ > $last+1 || $_ == $last) {
936*0Sstevel@tonic-gate                if ($min == $last) {
937*0Sstevel@tonic-gate                    push @canon, $last;
938*0Sstevel@tonic-gate                } else {
939*0Sstevel@tonic-gate                    push @canon, "$min-$last";
940*0Sstevel@tonic-gate                }
941*0Sstevel@tonic-gate                $min = $_;
942*0Sstevel@tonic-gate            }
943*0Sstevel@tonic-gate            $last = $_;
944*0Sstevel@tonic-gate        }
945*0Sstevel@tonic-gate        local $" = ", ";
946*0Sstevel@tonic-gate        push @result, "FAILED tests @canon\n";
947*0Sstevel@tonic-gate        $canon = join ' ', @canon;
948*0Sstevel@tonic-gate    } else {
949*0Sstevel@tonic-gate        push @result, "FAILED test $last\n";
950*0Sstevel@tonic-gate        $canon = $last;
951*0Sstevel@tonic-gate    }
952*0Sstevel@tonic-gate
953*0Sstevel@tonic-gate    push @result, "\tFailed $failed/$max tests, ";
954*0Sstevel@tonic-gate    if ($max) {
955*0Sstevel@tonic-gate	push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
956*0Sstevel@tonic-gate    } else {
957*0Sstevel@tonic-gate	push @result, "?% okay";
958*0Sstevel@tonic-gate    }
959*0Sstevel@tonic-gate    my $ender = 's' x ($skipped > 1);
960*0Sstevel@tonic-gate    my $good = $max - $failed - $skipped;
961*0Sstevel@tonic-gate    if ($skipped) {
962*0Sstevel@tonic-gate	my $skipmsg = " (less $skipped skipped test$ender: $good okay, ";
963*0Sstevel@tonic-gate	if ($max) {
964*0Sstevel@tonic-gate	    my $goodper = sprintf("%.2f",100*($good/$max));
965*0Sstevel@tonic-gate	    $skipmsg .= "$goodper%)";
966*0Sstevel@tonic-gate	} else {
967*0Sstevel@tonic-gate	    $skipmsg .= "?%)";
968*0Sstevel@tonic-gate	}
969*0Sstevel@tonic-gate	push @result, $skipmsg;
970*0Sstevel@tonic-gate    }
971*0Sstevel@tonic-gate    push @result, "\n";
972*0Sstevel@tonic-gate    my $txt = join "", @result;
973*0Sstevel@tonic-gate    ($txt, $canon);
974*0Sstevel@tonic-gate}
975*0Sstevel@tonic-gate
976*0Sstevel@tonic-gate=end _private
977*0Sstevel@tonic-gate
978*0Sstevel@tonic-gate=back
979*0Sstevel@tonic-gate
980*0Sstevel@tonic-gate=cut
981*0Sstevel@tonic-gate
982*0Sstevel@tonic-gate
983*0Sstevel@tonic-gate1;
984*0Sstevel@tonic-gate__END__
985*0Sstevel@tonic-gate
986*0Sstevel@tonic-gate
987*0Sstevel@tonic-gate=head1 EXPORT
988*0Sstevel@tonic-gate
989*0Sstevel@tonic-gateC<&runtests> is exported by Test::Harness by default.
990*0Sstevel@tonic-gate
991*0Sstevel@tonic-gateC<$verbose>, C<$switches> and C<$debug> are exported upon request.
992*0Sstevel@tonic-gate
993*0Sstevel@tonic-gate=head1 DIAGNOSTICS
994*0Sstevel@tonic-gate
995*0Sstevel@tonic-gate=over 4
996*0Sstevel@tonic-gate
997*0Sstevel@tonic-gate=item C<All tests successful.\nFiles=%d,  Tests=%d, %s>
998*0Sstevel@tonic-gate
999*0Sstevel@tonic-gateIf all tests are successful some statistics about the performance are
1000*0Sstevel@tonic-gateprinted.
1001*0Sstevel@tonic-gate
1002*0Sstevel@tonic-gate=item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
1003*0Sstevel@tonic-gate
1004*0Sstevel@tonic-gateFor any single script that has failing subtests statistics like the
1005*0Sstevel@tonic-gateabove are printed.
1006*0Sstevel@tonic-gate
1007*0Sstevel@tonic-gate=item C<Test returned status %d (wstat %d)>
1008*0Sstevel@tonic-gate
1009*0Sstevel@tonic-gateScripts that return a non-zero exit status, both C<$? E<gt>E<gt> 8>
1010*0Sstevel@tonic-gateand C<$?> are printed in a message similar to the above.
1011*0Sstevel@tonic-gate
1012*0Sstevel@tonic-gate=item C<Failed 1 test, %.2f%% okay. %s>
1013*0Sstevel@tonic-gate
1014*0Sstevel@tonic-gate=item C<Failed %d/%d tests, %.2f%% okay. %s>
1015*0Sstevel@tonic-gate
1016*0Sstevel@tonic-gateIf not all tests were successful, the script dies with one of the
1017*0Sstevel@tonic-gateabove messages.
1018*0Sstevel@tonic-gate
1019*0Sstevel@tonic-gate=item C<FAILED--Further testing stopped: %s>
1020*0Sstevel@tonic-gate
1021*0Sstevel@tonic-gateIf a single subtest decides that further testing will not make sense,
1022*0Sstevel@tonic-gatethe script dies with this message.
1023*0Sstevel@tonic-gate
1024*0Sstevel@tonic-gate=back
1025*0Sstevel@tonic-gate
1026*0Sstevel@tonic-gate=head1 ENVIRONMENT
1027*0Sstevel@tonic-gate
1028*0Sstevel@tonic-gate=over 4
1029*0Sstevel@tonic-gate
1030*0Sstevel@tonic-gate=item C<HARNESS_ACTIVE>
1031*0Sstevel@tonic-gate
1032*0Sstevel@tonic-gateHarness sets this before executing the individual tests.  This allows
1033*0Sstevel@tonic-gatethe tests to determine if they are being executed through the harness
1034*0Sstevel@tonic-gateor by any other means.
1035*0Sstevel@tonic-gate
1036*0Sstevel@tonic-gate=item C<HARNESS_COLUMNS>
1037*0Sstevel@tonic-gate
1038*0Sstevel@tonic-gateThis value will be used for the width of the terminal. If it is not
1039*0Sstevel@tonic-gateset then it will default to C<COLUMNS>. If this is not set, it will
1040*0Sstevel@tonic-gatedefault to 80. Note that users of Bourne-sh based shells will need to
1041*0Sstevel@tonic-gateC<export COLUMNS> for this module to use that variable.
1042*0Sstevel@tonic-gate
1043*0Sstevel@tonic-gate=item C<HARNESS_COMPILE_TEST>
1044*0Sstevel@tonic-gate
1045*0Sstevel@tonic-gateWhen true it will make harness attempt to compile the test using
1046*0Sstevel@tonic-gateC<perlcc> before running it.
1047*0Sstevel@tonic-gate
1048*0Sstevel@tonic-gateB<NOTE> This currently only works when sitting in the perl source
1049*0Sstevel@tonic-gatedirectory!
1050*0Sstevel@tonic-gate
1051*0Sstevel@tonic-gate=item C<HARNESS_DEBUG>
1052*0Sstevel@tonic-gate
1053*0Sstevel@tonic-gateIf true, Test::Harness will print debugging information about itself as
1054*0Sstevel@tonic-gateit runs the tests.  This is different from C<HARNESS_VERBOSE>, which prints
1055*0Sstevel@tonic-gatethe output from the test being run.  Setting C<$Test::Harness::Debug> will
1056*0Sstevel@tonic-gateoverride this, or you can use the C<-d> switch in the F<prove> utility.
1057*0Sstevel@tonic-gate
1058*0Sstevel@tonic-gate=item C<HARNESS_FILELEAK_IN_DIR>
1059*0Sstevel@tonic-gate
1060*0Sstevel@tonic-gateWhen set to the name of a directory, harness will check after each
1061*0Sstevel@tonic-gatetest whether new files appeared in that directory, and report them as
1062*0Sstevel@tonic-gate
1063*0Sstevel@tonic-gate  LEAKED FILES: scr.tmp 0 my.db
1064*0Sstevel@tonic-gate
1065*0Sstevel@tonic-gateIf relative, directory name is with respect to the current directory at
1066*0Sstevel@tonic-gatethe moment runtests() was called.  Putting absolute path into
1067*0Sstevel@tonic-gateC<HARNESS_FILELEAK_IN_DIR> may give more predictable results.
1068*0Sstevel@tonic-gate
1069*0Sstevel@tonic-gate=item C<HARNESS_IGNORE_EXITCODE>
1070*0Sstevel@tonic-gate
1071*0Sstevel@tonic-gateMakes harness ignore the exit status of child processes when defined.
1072*0Sstevel@tonic-gate
1073*0Sstevel@tonic-gate=item C<HARNESS_NOTTY>
1074*0Sstevel@tonic-gate
1075*0Sstevel@tonic-gateWhen set to a true value, forces it to behave as though STDOUT were
1076*0Sstevel@tonic-gatenot a console.  You may need to set this if you don't want harness to
1077*0Sstevel@tonic-gateoutput more frequent progress messages using carriage returns.  Some
1078*0Sstevel@tonic-gateconsoles may not handle carriage returns properly (which results in a
1079*0Sstevel@tonic-gatesomewhat messy output).
1080*0Sstevel@tonic-gate
1081*0Sstevel@tonic-gate=item C<HARNESS_OK_SLOW>
1082*0Sstevel@tonic-gate
1083*0Sstevel@tonic-gateIf true, the C<ok> messages are printed out only every second.  This
1084*0Sstevel@tonic-gatereduces output and may help increase testing speed over slow
1085*0Sstevel@tonic-gateconnections, or with very large numbers of tests.
1086*0Sstevel@tonic-gate
1087*0Sstevel@tonic-gate=item C<HARNESS_PERL>
1088*0Sstevel@tonic-gate
1089*0Sstevel@tonic-gateUsually your tests will be run by C<$^X>, the currently-executing Perl.
1090*0Sstevel@tonic-gateHowever, you may want to have it run by a different executable, such as
1091*0Sstevel@tonic-gatea threading perl, or a different version.
1092*0Sstevel@tonic-gate
1093*0Sstevel@tonic-gateIf you're using the F<prove> utility, you can use the C<--perl> switch.
1094*0Sstevel@tonic-gate
1095*0Sstevel@tonic-gate=item C<HARNESS_PERL_SWITCHES>
1096*0Sstevel@tonic-gate
1097*0Sstevel@tonic-gateIts value will be prepended to the switches used to invoke perl on
1098*0Sstevel@tonic-gateeach test.  For example, setting C<HARNESS_PERL_SWITCHES> to C<-W> will
1099*0Sstevel@tonic-gaterun all tests with all warnings enabled.
1100*0Sstevel@tonic-gate
1101*0Sstevel@tonic-gate=item C<HARNESS_VERBOSE>
1102*0Sstevel@tonic-gate
1103*0Sstevel@tonic-gateIf true, Test::Harness will output the verbose results of running
1104*0Sstevel@tonic-gateits tests.  Setting C<$Test::Harness::verbose> will override this,
1105*0Sstevel@tonic-gateor you can use the C<-v> switch in the F<prove> utility.
1106*0Sstevel@tonic-gate
1107*0Sstevel@tonic-gate=back
1108*0Sstevel@tonic-gate
1109*0Sstevel@tonic-gate=head1 EXAMPLE
1110*0Sstevel@tonic-gate
1111*0Sstevel@tonic-gateHere's how Test::Harness tests itself
1112*0Sstevel@tonic-gate
1113*0Sstevel@tonic-gate  $ cd ~/src/devel/Test-Harness
1114*0Sstevel@tonic-gate  $ perl -Mblib -e 'use Test::Harness qw(&runtests $verbose);
1115*0Sstevel@tonic-gate    $verbose=0; runtests @ARGV;' t/*.t
1116*0Sstevel@tonic-gate  Using /home/schwern/src/devel/Test-Harness/blib
1117*0Sstevel@tonic-gate  t/base..............ok
1118*0Sstevel@tonic-gate  t/nonumbers.........ok
1119*0Sstevel@tonic-gate  t/ok................ok
1120*0Sstevel@tonic-gate  t/test-harness......ok
1121*0Sstevel@tonic-gate  All tests successful.
1122*0Sstevel@tonic-gate  Files=4, Tests=24, 2 wallclock secs ( 0.61 cusr + 0.41 csys = 1.02 CPU)
1123*0Sstevel@tonic-gate
1124*0Sstevel@tonic-gate=head1 SEE ALSO
1125*0Sstevel@tonic-gate
1126*0Sstevel@tonic-gateL<Test> and L<Test::Simple> for writing test scripts, L<Benchmark> for
1127*0Sstevel@tonic-gatethe underlying timing routines, L<Devel::CoreStack> to generate core
1128*0Sstevel@tonic-gatedumps from failed tests and L<Devel::Cover> for test coverage
1129*0Sstevel@tonic-gateanalysis.
1130*0Sstevel@tonic-gate
1131*0Sstevel@tonic-gate=head1 AUTHORS
1132*0Sstevel@tonic-gate
1133*0Sstevel@tonic-gateEither Tim Bunce or Andreas Koenig, we don't know. What we know for
1134*0Sstevel@tonic-gatesure is, that it was inspired by Larry Wall's TEST script that came
1135*0Sstevel@tonic-gatewith perl distributions for ages. Numerous anonymous contributors
1136*0Sstevel@tonic-gateexist.  Andreas Koenig held the torch for many years, and then
1137*0Sstevel@tonic-gateMichael G Schwern.
1138*0Sstevel@tonic-gate
1139*0Sstevel@tonic-gateCurrent maintainer is Andy Lester C<< <andy@petdance.com> >>.
1140*0Sstevel@tonic-gate
1141*0Sstevel@tonic-gate=head1 LICENSE
1142*0Sstevel@tonic-gate
1143*0Sstevel@tonic-gateThis program is free software; you can redistribute it and/or
1144*0Sstevel@tonic-gatemodify it under the same terms as Perl itself.
1145*0Sstevel@tonic-gate
1146*0Sstevel@tonic-gateSee L<http://www.perl.com/perl/misc/Artistic.html>
1147*0Sstevel@tonic-gate
1148*0Sstevel@tonic-gate=head1 TODO
1149*0Sstevel@tonic-gate
1150*0Sstevel@tonic-gateProvide a way of running tests quietly (ie. no printing) for automated
1151*0Sstevel@tonic-gatevalidation of tests.  This will probably take the form of a version
1152*0Sstevel@tonic-gateof runtests() which rather than printing its output returns raw data
1153*0Sstevel@tonic-gateon the state of the tests.  (Partially done in Test::Harness::Straps)
1154*0Sstevel@tonic-gate
1155*0Sstevel@tonic-gateDocument the format.
1156*0Sstevel@tonic-gate
1157*0Sstevel@tonic-gateFix HARNESS_COMPILE_TEST without breaking its core usage.
1158*0Sstevel@tonic-gate
1159*0Sstevel@tonic-gateFigure a way to report test names in the failure summary.
1160*0Sstevel@tonic-gate
1161*0Sstevel@tonic-gateRework the test summary so long test names are not truncated as badly.
1162*0Sstevel@tonic-gate(Partially done with new skip test styles)
1163*0Sstevel@tonic-gate
1164*0Sstevel@tonic-gateDeal with VMS's "not \nok 4\n" mistake.
1165*0Sstevel@tonic-gate
1166*0Sstevel@tonic-gateAdd option for coverage analysis.
1167*0Sstevel@tonic-gate
1168*0Sstevel@tonic-gateTrap STDERR.
1169*0Sstevel@tonic-gate
1170*0Sstevel@tonic-gateImplement Straps total_results()
1171*0Sstevel@tonic-gate
1172*0Sstevel@tonic-gateRemember exit code
1173*0Sstevel@tonic-gate
1174*0Sstevel@tonic-gateCompletely redo the print summary code.
1175*0Sstevel@tonic-gate
1176*0Sstevel@tonic-gateImplement Straps callbacks.  (experimentally implemented)
1177*0Sstevel@tonic-gate
1178*0Sstevel@tonic-gateStraps->analyze_file() not taint clean, don't know if it can be
1179*0Sstevel@tonic-gate
1180*0Sstevel@tonic-gateFix that damned VMS nit.
1181*0Sstevel@tonic-gate
1182*0Sstevel@tonic-gateHARNESS_TODOFAIL to display TODO failures
1183*0Sstevel@tonic-gate
1184*0Sstevel@tonic-gateAdd a test for verbose.
1185*0Sstevel@tonic-gate
1186*0Sstevel@tonic-gateChange internal list of test results to a hash.
1187*0Sstevel@tonic-gate
1188*0Sstevel@tonic-gateFix stats display when there's an overrun.
1189*0Sstevel@tonic-gate
1190*0Sstevel@tonic-gateFix so perls with spaces in the filename work.
1191*0Sstevel@tonic-gate
1192*0Sstevel@tonic-gate=for _private
1193*0Sstevel@tonic-gate
1194*0Sstevel@tonic-gateKeeping whittling away at _run_all_tests()
1195*0Sstevel@tonic-gate
1196*0Sstevel@tonic-gate=for _private
1197*0Sstevel@tonic-gate
1198*0Sstevel@tonic-gateClean up how the summary is printed.  Get rid of those damned formats.
1199*0Sstevel@tonic-gate
1200*0Sstevel@tonic-gate=head1 BUGS
1201*0Sstevel@tonic-gate
1202*0Sstevel@tonic-gateHARNESS_COMPILE_TEST currently assumes it's run from the Perl source
1203*0Sstevel@tonic-gatedirectory.
1204*0Sstevel@tonic-gate
1205*0Sstevel@tonic-gatePlease use the CPAN bug ticketing system at L<http://rt.cpan.org/>.
1206*0Sstevel@tonic-gateYou can also mail bugs, fixes and enhancements to
1207*0Sstevel@tonic-gateC<< <bug-test-harness@rt.cpan.org> >>.
1208*0Sstevel@tonic-gate
1209*0Sstevel@tonic-gate=head1 AUTHORS
1210*0Sstevel@tonic-gate
1211*0Sstevel@tonic-gateOriginal code by Michael G Schwern, maintained by Andy Lester.
1212*0Sstevel@tonic-gate
1213*0Sstevel@tonic-gate=head1 COPYRIGHT
1214*0Sstevel@tonic-gate
1215*0Sstevel@tonic-gateCopyright 2003 by Michael G Schwern C<< <schwern@pobox.com> >>,
1216*0Sstevel@tonic-gate                  Andy Lester C<< <andy@petdance.com> >>.
1217*0Sstevel@tonic-gate
1218*0Sstevel@tonic-gateThis program is free software; you can redistribute it and/or
1219*0Sstevel@tonic-gatemodify it under the same terms as Perl itself.
1220*0Sstevel@tonic-gate
1221*0Sstevel@tonic-gateSee L<http://www.perl.com/perl/misc/Artistic.html>.
1222*0Sstevel@tonic-gate
1223*0Sstevel@tonic-gate=cut
1224