Commit | Line | Data |
---|---|---|
13287dd5 | 1 | # -*- Mode: cperl; cperl-indent-level: 4 -*- |
a72fde19 | 2 | # $Id: Straps.pm,v 1.16 2003/02/02 05:27:44 schwern Exp $ |
13287dd5 MS |
3 | |
4 | package Test::Harness::Straps; | |
5 | ||
6 | use strict; | |
7 | use vars qw($VERSION); | |
8 | use Config; | |
11c6125c | 9 | $VERSION = '0.14'; |
13287dd5 MS |
10 | |
11 | use Test::Harness::Assert; | |
12 | use Test::Harness::Iterator; | |
13 | ||
14 | # Flags used as return values from our methods. Just for internal | |
15 | # clarification. | |
16 | my $TRUE = (1==1); | |
17 | my $FALSE = !$TRUE; | |
18 | my $YES = $TRUE; | |
19 | my $NO = $FALSE; | |
20 | ||
21 | ||
22 | =head1 NAME | |
23 | ||
24 | Test::Harness::Straps - detailed analysis of test results | |
25 | ||
26 | =head1 SYNOPSIS | |
27 | ||
28 | use Test::Harness::Straps; | |
29 | ||
30 | my $strap = Test::Harness::Straps->new; | |
31 | ||
32 | # Various ways to interpret a test | |
33 | my %results = $strap->analyze($name, \@test_output); | |
34 | my %results = $strap->analyze_fh($name, $test_filehandle); | |
35 | my %results = $strap->analyze_file($test_file); | |
36 | ||
37 | # UNIMPLEMENTED | |
38 | my %total = $strap->total_results; | |
39 | ||
40 | # Altering the behavior of the strap UNIMPLEMENTED | |
41 | my $verbose_output = $strap->dump_verbose(); | |
42 | $strap->dump_verbose_fh($output_filehandle); | |
43 | ||
44 | ||
45 | =head1 DESCRIPTION | |
46 | ||
47 | B<THIS IS ALPHA SOFTWARE> in that the interface is subject to change | |
48 | in incompatible ways. It is otherwise stable. | |
49 | ||
50 | Test::Harness is limited to printing out its results. This makes | |
51 | analysis of the test results difficult for anything but a human. To | |
52 | make it easier for programs to work with test results, we provide | |
53 | Test::Harness::Straps. Instead of printing the results, straps | |
54 | provide them as raw data. You can also configure how the tests are to | |
55 | be run. | |
56 | ||
57 | The interface is currently incomplete. I<Please> contact the author | |
58 | if you'd like a feature added or something change or just have | |
59 | comments. | |
60 | ||
61 | =head2 Construction | |
62 | ||
63 | =over 4 | |
64 | ||
65 | =item B<new> | |
66 | ||
67 | my $strap = Test::Harness::Straps->new; | |
68 | ||
69 | Initialize a new strap. | |
70 | ||
71 | =cut | |
72 | ||
73 | sub new { | |
74 | my($proto) = shift; | |
75 | my($class) = ref $proto || $proto; | |
76 | ||
77 | my $self = bless {}, $class; | |
78 | $self->_init; | |
79 | ||
80 | return $self; | |
81 | } | |
82 | ||
83 | =begin _private | |
84 | ||
85 | =item B<_init> | |
86 | ||
87 | $strap->_init; | |
88 | ||
89 | Initialize the internal state of a strap to make it ready for parsing. | |
90 | ||
91 | =cut | |
92 | ||
93 | sub _init { | |
94 | my($self) = shift; | |
95 | ||
a72fde19 JH |
96 | $self->{_is_vms} = $^O eq 'VMS'; |
97 | $self->{_is_win32} = $^O eq 'Win32'; | |
13287dd5 MS |
98 | } |
99 | ||
100 | =end _private | |
101 | ||
102 | =back | |
103 | ||
104 | =head2 Analysis | |
105 | ||
106 | =over 4 | |
107 | ||
108 | =item B<analyze> | |
109 | ||
110 | my %results = $strap->analyze($name, \@test_output); | |
111 | ||
112 | Analyzes the output of a single test, assigning it the given $name for | |
113 | use in the total report. Returns the %results of the test. See | |
114 | L<Results>. | |
115 | ||
116 | @test_output should be the raw output from the test, including newlines. | |
117 | ||
118 | =cut | |
119 | ||
120 | sub analyze { | |
121 | my($self, $name, $test_output) = @_; | |
122 | ||
123 | my $it = Test::Harness::Iterator->new($test_output); | |
124 | return $self->_analyze_iterator($name, $it); | |
125 | } | |
126 | ||
127 | ||
128 | sub _analyze_iterator { | |
129 | my($self, $name, $it) = @_; | |
130 | ||
131 | $self->_reset_file_state; | |
132 | $self->{file} = $name; | |
133 | my %totals = ( | |
134 | max => 0, | |
135 | seen => 0, | |
136 | ||
137 | ok => 0, | |
138 | todo => 0, | |
139 | skip => 0, | |
140 | bonus => 0, | |
308957f5 | 141 | |
13287dd5 MS |
142 | details => [] |
143 | ); | |
144 | ||
308957f5 JH |
145 | # Set them up here so callbacks can have them. |
146 | $self->{totals}{$name} = \%totals; | |
13287dd5 MS |
147 | while( defined(my $line = $it->next) ) { |
148 | $self->_analyze_line($line, \%totals); | |
149 | last if $self->{saw_bailout}; | |
150 | } | |
151 | ||
356733da MS |
152 | $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all}; |
153 | ||
a72fde19 JH |
154 | my $passed = ($totals{max} == 0 && defined $totals{skip_all}) || |
155 | ($totals{max} && $totals{seen} && | |
156 | $totals{max} == $totals{seen} && | |
157 | $totals{max} == $totals{ok}); | |
13287dd5 MS |
158 | $totals{passing} = $passed ? 1 : 0; |
159 | ||
13287dd5 MS |
160 | return %totals; |
161 | } | |
162 | ||
163 | ||
164 | sub _analyze_line { | |
165 | my($self, $line, $totals) = @_; | |
166 | ||
167 | my %result = (); | |
308957f5 | 168 | |
13287dd5 MS |
169 | $self->{line}++; |
170 | ||
171 | my $type; | |
172 | if( $self->_is_header($line) ) { | |
173 | $type = 'header'; | |
174 | ||
175 | $self->{saw_header}++; | |
308957f5 | 176 | |
13287dd5 MS |
177 | $totals->{max} += $self->{max}; |
178 | } | |
179 | elsif( $self->_is_test($line, \%result) ) { | |
180 | $type = 'test'; | |
181 | ||
182 | $totals->{seen}++; | |
183 | $result{number} = $self->{'next'} unless $result{number}; | |
184 | ||
185 | # sometimes the 'not ' and the 'ok' are on different lines, | |
186 | # happens often on VMS if you do: | |
187 | # print "not " unless $test; | |
188 | # print "ok $num\n"; | |
189 | if( $self->{saw_lone_not} && | |
190 | ($self->{lone_not_line} == $self->{line} - 1) ) | |
d5d4ec93 | 191 | { |
13287dd5 MS |
192 | $result{ok} = 0; |
193 | } | |
194 | ||
195 | my $pass = $result{ok}; | |
196 | $result{type} = 'todo' if $self->{todo}{$result{number}}; | |
197 | ||
198 | if( $result{type} eq 'todo' ) { | |
199 | $totals->{todo}++; | |
200 | $pass = 1; | |
201 | $totals->{bonus}++ if $result{ok} | |
202 | } | |
203 | elsif( $result{type} eq 'skip' ) { | |
204 | $totals->{skip}++; | |
205 | $pass = 1; | |
206 | } | |
207 | ||
208 | $totals->{ok}++ if $pass; | |
209 | ||
a72fde19 | 210 | if( $result{number} > 100000 && $result{number} > $self->{max} ) { |
d5d4ec93 | 211 | warn "Enormous test number seen [test $result{number}]\n"; |
356733da MS |
212 | warn "Can't detailize, too big.\n"; |
213 | } | |
214 | else { | |
215 | $totals->{details}[$result{number} - 1] = | |
13287dd5 | 216 | {$self->_detailize($pass, \%result)}; |
356733da | 217 | } |
13287dd5 MS |
218 | |
219 | # XXX handle counter mismatch | |
220 | } | |
221 | elsif ( $self->_is_bail_out($line, \$self->{bailout_reason}) ) { | |
222 | $type = 'bailout'; | |
223 | $self->{saw_bailout} = 1; | |
224 | } | |
225 | else { | |
226 | $type = 'other'; | |
227 | } | |
228 | ||
229 | $self->{callback}->($self, $line, $type, $totals) if $self->{callback}; | |
230 | ||
231 | $self->{'next'} = $result{number} + 1 if $type eq 'test'; | |
232 | } | |
233 | ||
234 | =item B<analyze_fh> | |
235 | ||
236 | my %results = $strap->analyze_fh($name, $test_filehandle); | |
237 | ||
238 | Like C<analyze>, but it reads from the given filehandle. | |
239 | ||
240 | =cut | |
241 | ||
242 | sub analyze_fh { | |
243 | my($self, $name, $fh) = @_; | |
244 | ||
245 | my $it = Test::Harness::Iterator->new($fh); | |
246 | $self->_analyze_iterator($name, $it); | |
247 | } | |
248 | ||
249 | =item B<analyze_file> | |
250 | ||
251 | my %results = $strap->analyze_file($test_file); | |
252 | ||
356733da MS |
253 | Like C<analyze>, but it runs the given $test_file and parses it's |
254 | results. It will also use that name for the total report. | |
13287dd5 MS |
255 | |
256 | =cut | |
257 | ||
258 | sub analyze_file { | |
259 | my($self, $file) = @_; | |
260 | ||
0be28027 JH |
261 | unless( -e $file ) { |
262 | $self->{error} = "$file does not exist"; | |
263 | return; | |
264 | } | |
265 | ||
266 | unless( -r $file ) { | |
267 | $self->{error} = "$file is not readable"; | |
268 | return; | |
269 | } | |
270 | ||
13287dd5 MS |
271 | local $ENV{PERL5LIB} = $self->_INC2PERL5LIB; |
272 | ||
a72fde19 JH |
273 | my $cmd = $self->{_is_vms} ? "MCR $^X" : |
274 | $self->{_is_win32} ? Win32::GetShortPathName($^X) | |
275 | : $^X; | |
13287dd5 MS |
276 | |
277 | my $switches = $self->_switches($file); | |
278 | ||
279 | # *sigh* this breaks under taint, but open -| is unportable. | |
280 | unless( open(FILE, "$cmd $switches $file|") ) { | |
281 | print "can't run $file. $!\n"; | |
282 | return; | |
283 | } | |
284 | ||
285 | my %results = $self->analyze_fh($file, \*FILE); | |
356733da MS |
286 | my $exit = close FILE; |
287 | $results{'wait'} = $?; | |
f0008e52 MS |
288 | if( $? && $self->{_is_vms} ) { |
289 | eval q{use vmsish "status"; $results{'exit'} = $?}; | |
290 | } | |
291 | else { | |
6e5a998b | 292 | $results{'exit'} = _wait2exit($?); |
f0008e52 | 293 | } |
356733da | 294 | $results{passing} = 0 unless $? == 0; |
13287dd5 MS |
295 | |
296 | $self->_restore_PERL5LIB(); | |
297 | ||
298 | return %results; | |
299 | } | |
300 | ||
6e5a998b MS |
301 | |
302 | eval { require POSIX; &POSIX::WEXITSTATUS(0) }; | |
303 | if( $@ ) { | |
304 | *_wait2exit = sub { $_[0] >> 8 }; | |
305 | } | |
306 | else { | |
307 | *_wait2exit = sub { POSIX::WEXITSTATUS($_[0]) } | |
308 | } | |
309 | ||
310 | ||
13287dd5 MS |
311 | =begin _private |
312 | ||
313 | =item B<_switches> | |
314 | ||
315 | my $switches = $self->_switches($file); | |
316 | ||
317 | Formats and returns the switches necessary to run the test. | |
318 | ||
319 | =cut | |
320 | ||
321 | sub _switches { | |
322 | my($self, $file) = @_; | |
323 | ||
324 | local *TEST; | |
325 | open(TEST, $file) or print "can't open $file. $!\n"; | |
326 | my $first = <TEST>; | |
327 | my $s = ''; | |
328 | $s .= " $ENV{'HARNESS_PERL_SWITCHES'}" | |
329 | if exists $ENV{'HARNESS_PERL_SWITCHES'}; | |
0be28027 | 330 | |
11c6125c MS |
331 | if ($first =~ /^#!.*\bperl.*\s-\w*([Tt]+)/) { |
332 | # When taint mode is on, PERL5LIB is ignored. So we need to put | |
333 | # all that on the command line as -Is. | |
334 | $s .= join " ", qq[ "-$1"], map {qq["-I$_"]} $self->_filtered_INC; | |
335 | } | |
336 | elsif ($^O eq 'MacOS') { | |
337 | # MacPerl's putenv is broken, so it will not see PERL5LIB. | |
338 | $s .= join " ", map {qq["-I$_"]} $self->_filtered_INC; | |
339 | } | |
13287dd5 MS |
340 | |
341 | close(TEST) or print "can't close $file. $!\n"; | |
342 | ||
343 | return $s; | |
344 | } | |
345 | ||
346 | ||
347 | =item B<_INC2PERL5LIB> | |
348 | ||
349 | local $ENV{PERL5LIB} = $self->_INC2PERL5LIB; | |
350 | ||
351 | Takes the current value of @INC and turns it into something suitable | |
352 | for putting onto PERL5LIB. | |
353 | ||
354 | =cut | |
355 | ||
356 | sub _INC2PERL5LIB { | |
357 | my($self) = shift; | |
358 | ||
359 | $self->{_old5lib} = $ENV{PERL5LIB}; | |
360 | ||
361 | return join $Config{path_sep}, $self->_filtered_INC; | |
d5d4ec93 | 362 | } |
13287dd5 MS |
363 | |
364 | =item B<_filtered_INC> | |
365 | ||
366 | my @filtered_inc = $self->_filtered_INC; | |
367 | ||
368 | Shortens @INC by removing redundant and unnecessary entries. | |
369 | Necessary for OS's with limited command line lengths, like VMS. | |
370 | ||
371 | =cut | |
372 | ||
373 | sub _filtered_INC { | |
374 | my($self, @inc) = @_; | |
375 | @inc = @INC unless @inc; | |
376 | ||
377 | # VMS has a 255-byte limit on the length of %ENV entries, so | |
378 | # toss the ones that involve perl_root, the install location | |
379 | # for VMS | |
380 | if( $self->{_is_vms} ) { | |
381 | @inc = grep !/perl_root/i, @inc; | |
382 | } | |
383 | ||
384 | return @inc; | |
385 | } | |
386 | ||
387 | ||
388 | =item B<_restore_PERL5LIB> | |
389 | ||
390 | $self->_restore_PERL5LIB; | |
391 | ||
392 | This restores the original value of the PERL5LIB environment variable. | |
393 | Necessary on VMS, otherwise a no-op. | |
394 | ||
395 | =cut | |
396 | ||
397 | sub _restore_PERL5LIB { | |
398 | my($self) = shift; | |
399 | ||
400 | return unless $self->{_is_vms}; | |
401 | ||
402 | if (defined $self->{_old5lib}) { | |
403 | $ENV{PERL5LIB} = $self->{_old5lib}; | |
404 | } | |
405 | } | |
d5d4ec93 | 406 | |
13287dd5 MS |
407 | |
408 | =end _private | |
409 | ||
410 | =back | |
411 | ||
412 | ||
413 | =begin _private | |
414 | ||
415 | =head2 Parsing | |
416 | ||
417 | Methods for identifying what sort of line you're looking at. | |
418 | ||
419 | =over 4 | |
420 | ||
421 | =item B<_is_comment> | |
422 | ||
423 | my $is_comment = $strap->_is_comment($line, \$comment); | |
424 | ||
425 | Checks if the given line is a comment. If so, it will place it into | |
426 | $comment (sans #). | |
427 | ||
428 | =cut | |
429 | ||
430 | sub _is_comment { | |
431 | my($self, $line, $comment) = @_; | |
432 | ||
433 | if( $line =~ /^\s*\#(.*)/ ) { | |
434 | $$comment = $1; | |
435 | return $YES; | |
436 | } | |
437 | else { | |
438 | return $NO; | |
439 | } | |
440 | } | |
441 | ||
442 | =item B<_is_header> | |
443 | ||
444 | my $is_header = $strap->_is_header($line); | |
445 | ||
446 | Checks if the given line is a header (1..M) line. If so, it places | |
447 | how many tests there will be in $strap->{max}, a list of which tests | |
448 | are todo in $strap->{todo} and if the whole test was skipped | |
449 | $strap->{skip_all} contains the reason. | |
450 | ||
451 | =cut | |
452 | ||
453 | # Regex for parsing a header. Will be run with /x | |
454 | my $Extra_Header_Re = <<'REGEX'; | |
455 | ^ | |
456 | (?: \s+ todo \s+ ([\d \t]+) )? # optional todo set | |
457 | (?: \s* \# \s* ([\w:]+\s?) (.*) )? # optional skip with optional reason | |
458 | REGEX | |
459 | ||
460 | sub _is_header { | |
461 | my($self, $line) = @_; | |
462 | ||
463 | if( my($max, $extra) = $line =~ /^1\.\.(\d+)(.*)/ ) { | |
464 | $self->{max} = $max; | |
465 | assert( $self->{max} >= 0, 'Max # of tests looks right' ); | |
0be28027 JH |
466 | |
467 | if( defined $extra ) { | |
13287dd5 MS |
468 | my($todo, $skip, $reason) = $extra =~ /$Extra_Header_Re/xo; |
469 | ||
470 | $self->{todo} = { map { $_ => 1 } split /\s+/, $todo } if $todo; | |
471 | ||
a72fde19 JH |
472 | if( $self->{max} == 0 ) { |
473 | $reason = '' unless defined $skip and $skip =~ /^Skip/i; | |
474 | } | |
475 | ||
476 | $self->{skip_all} = $reason; | |
13287dd5 MS |
477 | } |
478 | ||
479 | return $YES; | |
480 | } | |
481 | else { | |
482 | return $NO; | |
483 | } | |
484 | } | |
485 | ||
486 | =item B<_is_test> | |
487 | ||
488 | my $is_test = $strap->_is_test($line, \%test); | |
489 | ||
490 | Checks if the $line is a test report (ie. 'ok/not ok'). Reports the | |
491 | result back in %test which will contain: | |
492 | ||
493 | ok did it succeed? This is the literal 'ok' or 'not ok'. | |
494 | name name of the test (if any) | |
495 | number test number (if any) | |
496 | ||
497 | type 'todo' or 'skip' (if any) | |
498 | reason why is it todo or skip? (if any) | |
499 | ||
500 | If will also catch lone 'not' lines, note it saw them | |
501 | $strap->{saw_lone_not} and the line in $strap->{lone_not_line}. | |
502 | ||
503 | =cut | |
504 | ||
505 | my $Report_Re = <<'REGEX'; | |
506 | ^ | |
507 | (not\ )? # failure? | |
508 | ok\b | |
509 | (?:\s+(\d+))? # optional test number | |
510 | \s* | |
511 | (.*) # and the rest | |
512 | REGEX | |
513 | ||
514 | my $Extra_Re = <<'REGEX'; | |
515 | ^ | |
516 | (.*?) (?:(?:[^\\]|^)# (.*))? | |
517 | $ | |
518 | REGEX | |
519 | ||
520 | sub _is_test { | |
521 | my($self, $line, $test) = @_; | |
522 | ||
523 | # We pulverize the line down into pieces in three parts. | |
524 | if( my($not, $num, $extra) = $line =~ /$Report_Re/ox ) { | |
525 | my($name, $control) = split /(?:[^\\]|^)#/, $extra if $extra; | |
526 | my($type, $reason) = $control =~ /^\s*(\S+)(?:\s+(.*))?$/ if $control; | |
527 | ||
528 | $test->{number} = $num; | |
529 | $test->{ok} = $not ? 0 : 1; | |
530 | $test->{name} = $name; | |
531 | ||
532 | if( defined $type ) { | |
533 | $test->{type} = $type =~ /^TODO$/i ? 'todo' : | |
534 | $type =~ /^Skip/i ? 'skip' : 0; | |
535 | } | |
536 | else { | |
537 | $test->{type} = ''; | |
538 | } | |
539 | $test->{reason} = $reason; | |
540 | ||
541 | return $YES; | |
542 | } | |
543 | else{ | |
544 | # Sometimes the "not " and "ok" will be on seperate lines on VMS. | |
545 | # We catch this and remember we saw it. | |
546 | if( $line =~ /^not\s+$/ ) { | |
547 | $self->{saw_lone_not} = 1; | |
548 | $self->{lone_not_line} = $self->{line}; | |
549 | } | |
550 | ||
551 | return $NO; | |
552 | } | |
553 | } | |
554 | ||
555 | =item B<_is_bail_out> | |
556 | ||
557 | my $is_bail_out = $strap->_is_bail_out($line, \$reason); | |
558 | ||
559 | Checks if the line is a "Bail out!". Places the reason for bailing | |
560 | (if any) in $reason. | |
561 | ||
562 | =cut | |
563 | ||
564 | sub _is_bail_out { | |
565 | my($self, $line, $reason) = @_; | |
566 | ||
567 | if( $line =~ /^Bail out!\s*(.*)/i ) { | |
568 | $$reason = $1 if $1; | |
569 | return $YES; | |
570 | } | |
571 | else { | |
572 | return $NO; | |
573 | } | |
574 | } | |
575 | ||
576 | =item B<_reset_file_state> | |
577 | ||
578 | $strap->_reset_file_state; | |
579 | ||
580 | Resets things like $strap->{max}, $strap->{skip_all}, etc... so its | |
581 | ready to parse the next file. | |
582 | ||
583 | =cut | |
584 | ||
585 | sub _reset_file_state { | |
586 | my($self) = shift; | |
587 | ||
588 | delete @{$self}{qw(max skip_all todo)}; | |
589 | $self->{line} = 0; | |
590 | $self->{saw_header} = 0; | |
591 | $self->{saw_bailout}= 0; | |
592 | $self->{saw_lone_not} = 0; | |
593 | $self->{lone_not_line} = 0; | |
594 | $self->{bailout_reason} = ''; | |
595 | $self->{'next'} = 1; | |
596 | } | |
597 | ||
598 | =back | |
599 | ||
600 | =end _private | |
601 | ||
602 | ||
603 | =head2 Results | |
604 | ||
605 | The %results returned from analyze() contain the following information: | |
606 | ||
607 | passing true if the whole test is considered a pass | |
608 | (or skipped), false if its a failure | |
609 | ||
356733da MS |
610 | exit the exit code of the test run, if from a file |
611 | wait the wait code of the test run, if from a file | |
612 | ||
13287dd5 MS |
613 | max total tests which should have been run |
614 | seen total tests actually seen | |
615 | skip_all if the whole test was skipped, this will | |
616 | contain the reason. | |
617 | ||
618 | ok number of tests which passed | |
619 | (including todo and skips) | |
620 | ||
621 | todo number of todo tests seen | |
622 | bonus number of todo tests which | |
623 | unexpectedly passed | |
624 | ||
625 | skip number of tests skipped | |
626 | ||
627 | So a successful test should have max == seen == ok. | |
628 | ||
629 | ||
630 | There is one final item, the details. | |
631 | ||
632 | details an array ref reporting the result of | |
633 | each test looks like this: | |
634 | ||
635 | $results{details}[$test_num - 1] = | |
636 | { ok => is the test considered ok? | |
637 | actual_ok => did it literally say 'ok'? | |
638 | name => name of the test (if any) | |
639 | type => 'skip' or 'todo' (if any) | |
640 | reason => reason for the above (if any) | |
641 | }; | |
642 | ||
643 | Element 0 of the details is test #1. I tried it with element 1 being | |
644 | #1 and 0 being empty, this is less awkward. | |
645 | ||
646 | =begin _private | |
647 | ||
648 | =over 4 | |
649 | ||
650 | =item B<_detailize> | |
651 | ||
652 | my %details = $strap->_detailize($pass, \%test); | |
653 | ||
654 | Generates the details based on the last test line seen. $pass is true | |
655 | if it was considered to be a passed test. %test is the results of the | |
656 | test you're summarizing. | |
657 | ||
658 | =cut | |
659 | ||
660 | sub _detailize { | |
661 | my($self, $pass, $test) = @_; | |
662 | ||
663 | my %details = ( ok => $pass, | |
664 | actual_ok => $test->{ok} | |
665 | ); | |
666 | ||
667 | assert( !(grep !defined $details{$_}, keys %details), | |
668 | 'test contains the ok and actual_ok info' ); | |
669 | ||
308957f5 JH |
670 | # We don't want these to be undef because they are often |
671 | # checked and don't want the checker to have to deal with | |
672 | # uninitialized vars. | |
13287dd5 | 673 | foreach my $piece (qw(name type reason)) { |
308957f5 | 674 | $details{$piece} = defined $test->{$piece} ? $test->{$piece} : ''; |
13287dd5 MS |
675 | } |
676 | ||
677 | return %details; | |
678 | } | |
679 | ||
680 | =back | |
681 | ||
682 | =end _private | |
683 | ||
684 | =head1 EXAMPLES | |
685 | ||
686 | See F<examples/mini_harness.plx> for an example of use. | |
687 | ||
688 | =head1 AUTHOR | |
689 | ||
690 | Michael G Schwern E<lt>schwern@pobox.comE<gt> | |
691 | ||
692 | =head1 SEE ALSO | |
693 | ||
694 | L<Test::Harness> | |
695 | ||
696 | =cut | |
697 | ||
698 | ||
699 | 1; |