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