File Coverage

support/Test/Harness.pm
Criterion Covered Total %
statement 152 328 46.3
branch 44 142 31.0
condition 9 39 23.1
subroutine 23 30 76.7
pod 2 9 22.2
total 230 548 42.0


line stmt bran cond sub pod time code
1             # -*- Mode: cperl; cperl-indent-level: 4 -*-
2              
3             package Test::Harness;
4              
5             require 5.00405;
6 1     1   37 use Test::Harness::Straps;
  1         10  
  1         22  
7 1     1   19 use Test::Harness::Assert;
  1         9  
  1         20  
8 1     1   15 use Exporter;
  1         9  
  1         14  
9 1     1   36 use Benchmark;
  1         10  
  1         18  
10 1     1   16 use Config;
  1         10  
  1         15  
11 1     1   15 use strict;
  1         9  
  1         1319  
12              
13              
14 1         17 use vars qw(
15             $VERSION
16             @ISA @EXPORT @EXPORT_OK
17             $Verbose $Switches $Debug
18             $verbose $switches $debug
19             $Columns
20             $Timer
21             $ML $Last_ML_Print
22             $Strap
23             $has_time_hires
24 1     1   14 );
  1         9  
25              
26             BEGIN {
27 1     1   9     eval "use Time::HiRes 'time'";
  1     1   16  
  1         9  
  1         16  
28 1         23     $has_time_hires = !$@;
29             }
30              
31             =head1 NAME
32            
33             Test::Harness - Run Perl standard test scripts with statistics
34            
35             =head1 VERSION
36            
37             Version 2.62
38            
39             =cut
40              
41             $VERSION = '2.62';
42              
43             # Backwards compatibility for exportable variable names.
44             *verbose  = *Verbose;
45             *switches = *Switches;
46             *debug    = *Debug;
47              
48             $ENV{HARNESS_ACTIVE} = 1;
49             $ENV{HARNESS_VERSION} = $VERSION;
50              
51             END {
52             # For VMS.
53                 delete $ENV{HARNESS_ACTIVE};
54                 delete $ENV{HARNESS_VERSION};
55             }
56              
57             my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
58              
59             $Strap = Test::Harness::Straps->new;
60              
61 0     0 0 0 sub strap { return $Strap };
62              
63             @ISA = ('Exporter');
64             @EXPORT    = qw(&runtests);
65             @EXPORT_OK = qw(&execute_tests $verbose $switches);
66              
67             $Verbose  = $ENV{HARNESS_VERBOSE} || 0;
68             $Debug    = $ENV{HARNESS_DEBUG} || 0;
69             $Switches = "-w";
70             $Columns  = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
71             $Columns--;             # Some shells have trouble with a full line of text.
72             $Timer    = $ENV{HARNESS_TIMER} || 0;
73              
74             =head1 SYNOPSIS
75            
76             use Test::Harness;
77            
78             runtests(@test_files);
79            
80             =head1 DESCRIPTION
81            
82             B<STOP!> If all you want to do is write a test script, consider
83             using Test::Simple. Test::Harness is the module that reads the
84             output from Test::Simple, Test::More and other modules based on
85             Test::Builder. You don't need to know about Test::Harness to use
86             those modules.
87            
88             Test::Harness runs tests and expects output from the test in a
89             certain format. That format is called TAP, the Test Anything
90             Protocol. It is defined in L<Test::Harness::TAP>.
91            
92             C<Test::Harness::runtests(@tests)> runs all the testscripts named
93             as arguments and checks standard output for the expected strings
94             in TAP format.
95            
96             The F<prove> utility is a thin wrapper around Test::Harness.
97            
98             =head2 Taint mode
99            
100             Test::Harness will honor the C<-T> or C<-t> in the #! line on your
101             test files. So if you begin a test with:
102            
103             #!perl -T
104            
105             the test will be run with taint mode on.
106            
107             =head2 Configuration variables.
108            
109             These variables can be used to configure the behavior of
110             Test::Harness. They are exported on request.
111            
112             =over 4
113            
114             =item C<$Test::Harness::Verbose>
115            
116             The package variable C<$Test::Harness::Verbose> is exportable and can be
117             used to let C<runtests()> display the standard output of the script
118             without altering the behavior otherwise. The F<prove> utility's C<-v>
119             flag will set this.
120            
121             =item C<$Test::Harness::switches>
122            
123             The package variable C<$Test::Harness::switches> is exportable and can be
124             used to set perl command line options used for running the test
125             script(s). The default value is C<-w>. It overrides C<HARNESS_PERL_SWITCHES>.
126            
127             =item C<$Test::Harness::Timer>
128            
129             If set to true, and C<Time::HiRes> is available, print elapsed seconds
130             after each test file.
131            
132             =back
133            
134            
135             =head2 Failure
136            
137             When tests fail, analyze the summary report:
138            
139             t/base..............ok
140             t/nonumbers.........ok
141             t/ok................ok
142             t/test-harness......ok
143             t/waterloo..........dubious
144             Test returned status 3 (wstat 768, 0x300)
145             DIED. FAILED tests 1, 3, 5, 7, 9, 11, 13, 15, 17, 19
146             Failed 10/20 tests, 50.00% okay
147             Failed Test Stat Wstat Total Fail List of Failed
148             ---------------------------------------------------------------
149             t/waterloo.t 3 768 20 10 1 3 5 7 9 11 13 15 17 19
150             Failed 1/5 test scripts, 80.00% okay. 10/44 subtests failed, 77.27% okay.
151            
152             Everything passed but F<t/waterloo.t>. It failed 10 of 20 tests and
153             exited with non-zero status indicating something dubious happened.
154            
155             The columns in the summary report mean:
156            
157             =over 4
158            
159             =item B<Failed Test>
160            
161             The test file which failed.
162            
163             =item B<Stat>
164            
165             If the test exited with non-zero, this is its exit status.
166            
167             =item B<Wstat>
168            
169             The wait status of the test.
170            
171             =item B<Total>
172            
173             Total number of tests expected to run.
174            
175             =item B<Fail>
176            
177             Number which failed, either from "not ok" or because they never ran.
178            
179             =item B<List of Failed>
180            
181             A list of the tests which failed. Successive failures may be
182             abbreviated (ie. 15-20 to indicate that tests 15, 16, 17, 18, 19 and
183             20 failed).
184            
185             =back
186            
187            
188             =head1 FUNCTIONS
189            
190             The following functions are available.
191            
192             =head2 runtests( @test_files )
193            
194             This runs all the given I<@test_files> and divines whether they passed
195             or failed based on their output to STDOUT (details above). It prints
196             out each individual test which failed along with a summary report and
197             a how long it all took.
198            
199             It returns true if everything was ok. Otherwise it will C<die()> with
200             one of the messages in the DIAGNOSTICS section.
201            
202             =cut
203              
204             sub runtests {
205 1     1 1 34862     my(@tests) = @_;
206              
207 1         14     local ($\, $,);
208              
209 1         13     my ($tot, $failedtests,$todo_passed) = execute_tests(tests => \@tests);
210 1         180     print get_results($tot, $failedtests,$todo_passed);
211              
212 1         71     my $ok = _all_ok($tot);
213              
214 1   25     52     assert(($ok xor keys %$failedtests),
215                        q{ok status jives with $failedtests});
216              
217 1 50       11     if (! $ok) {
218 0         0         die("Failed $tot->{bad}/$tot->{tests} test programs. " .
219 0         0             "@{[$tot->{max} - $tot->{ok}]}/$tot->{max} subtests failed.\n");
220                 }
221              
222 1         247     return $ok;
223             }
224              
225             # my $ok = _all_ok(\%tot);
226             # Tells you if this test run is overall successful or not.
227              
228             sub _all_ok {
229 2     2   22     my($tot) = shift;
230              
231 2 50 33     52     return $tot->{bad} == 0 && ($tot->{max} || $tot->{skipped}) ? 1 : 0;
      33        
232             }
233              
234             # Returns all the files in a directory. This is shorthand for backwards
235             # compatibility on systems where C<glob()> doesn't work right.
236              
237             sub _globdir {
238 0     0   0     local *DIRH;
239              
240 0         0     opendir DIRH, shift;
241 0         0     my @f = readdir DIRH;
242 0         0     closedir DIRH;
243              
244 0         0     return @f;
245             }
246              
247             =head2 execute_tests( tests => \@test_files, out => \*FH )
248            
249             Runs all the given C<@test_files> (just like C<runtests()>) but
250             doesn't generate the final report. During testing, progress
251             information will be written to the currently selected output
252             filehandle (usually C<STDOUT>), or to the filehandle given by the
253             C<out> parameter. The I<out> is optional.
254            
255             Returns a list of two values, C<$total> and C<$failed>, describing the
256             results. C<$total> is a hash ref summary of all the tests run. Its
257             keys and values are this:
258            
259             bonus Number of individual todo tests unexpectedly passed
260             max Number of individual tests ran
261             ok Number of individual tests passed
262             sub_skipped Number of individual tests skipped
263             todo Number of individual todo tests
264            
265             files Number of test files ran
266             good Number of test files passed
267             bad Number of test files failed
268             tests Number of test files originally given
269             skipped Number of test files skipped
270            
271             If C<< $total->{bad} == 0 >> and C<< $total->{max} > 0 >>, you've
272             got a successful test.
273            
274             C<$failed> is a hash ref of all the test scripts that failed. Each key
275             is the name of a test script, each value is another hash representing
276             how that script failed. Its keys are these:
277            
278             name Name of the test which failed
279             estat Script's exit value
280             wstat Script's wait status
281             max Number of individual tests
282             failed Number which failed
283             canon List of tests which failed (as string).
284            
285             C<$failed> should be empty if everything passed.
286            
287             =cut
288              
289             sub execute_tests {
290 1     1 1 12     my %args = @_;
291 1         9     my @tests = @{$args{tests}};
  1         537  
292 1   33     22     my $out = $args{out} || select();
293              
294             # We allow filehandles that are symbolic refs
295 1     1   25     no strict 'refs';
  1         11  
  1         18  
296 1         12     _autoflush($out);
297 1         10     _autoflush(\*STDERR);
298              
299 1         9     my %failedtests;
300 1         9     my %todo_passed;
301              
302             # Test-wide totals.
303 1         20     my(%tot) = (
304                             bonus => 0,
305                             max => 0,
306                             ok => 0,
307                             files => 0,
308                             bad => 0,
309                             good => 0,
310                             tests => scalar @tests,
311                             sub_skipped => 0,
312                             todo => 0,
313                             skipped => 0,
314                             bench => 0,
315                            );
316              
317 1         9     my @dir_files;
318 1 50       11     @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
319 1         18     my $run_start_time = new Benchmark;
320              
321 1         130     my $width = _leader_width(@tests);
322 1         12     foreach my $tfile (@tests) {
323 58         1644         $Last_ML_Print = 0; # so each test prints at least once
324 58         3465         my($leader, $ml) = _mk_leader($tfile, $width);
325 58         681         local $ML = $ml;
326              
327 58         33508         print $out $leader;
328              
329 58         611         $tot{files}++;
330              
331 58         1820         $Strap->{_seen_header} = 0;
332 58 50       587         if ( $Test::Harness::Debug ) {
333 0         0             print $out "# Running: ", $Strap->_command_line($tfile), "\n";
334                     }
335 58 50       689         my $test_start_time = $Timer ? time : 0;
336                     my %results = $Strap->analyze_file($tfile) or
337 58 50       3315           do { warn $Strap->{error}, "\n"; next };
  0         0  
  0         0  
338 58         725         my $elapsed;
339 58 50       538         if ( $Timer ) {
340 0         0             $elapsed = time - $test_start_time;
341 0 0       0             if ( $has_time_hires ) {
342 0         0                 $elapsed = sprintf( " %8d ms", $elapsed*1000 );
343                         }
344                         else {
345 0 0       0                 $elapsed = sprintf( " %8s s", $elapsed ? $elapsed : "<1" );
346                         }
347                     }
348                     else {
349 58         687             $elapsed = "";
350                     }
351              
352             # state of the current test.
353 50334         1293728         my @failed = grep { !$results{details}[$_-1]{ok} }
  58         21084  
354 58         676                      1..@{$results{details}};
355 50334 50       1537344         my @todo_pass = grep { $results{details}[$_-1]{actual_ok} &&
  58         6822  
356                                            $results{details}[$_-1]{type} eq 'todo' }
357 58         11286                         1..@{$results{details}};
358              
359 58         15126         my %test = (
360                                 ok => $results{ok},
361                                 'next' => $Strap->{'next'},
362                                 max => $results{max},
363                                 failed => \@failed,
364                                 todo_pass => \@todo_pass,
365                                 todo => $results{todo},
366                                 bonus => $results{bonus},
367                                 skipped => $results{skip},
368                                 skip_reason => $results{skip_reason},
369                                 skip_all => $Strap->{skip_all},
370                                 ml => $ml,
371                                );
372              
373 58         1873         $tot{bonus} += $results{bonus};
374 58         2433         $tot{max} +=