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