| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package Test::Builder; 2 3 use 5.004; 4 5 # $^C was only introduced in 5.005-ish. We do this to prevent 6 # use of uninitialized value warnings in older perls. 7 $^C ||= 0; 8 9 use strict; 10 use vars qw($VERSION); 11 $VERSION = '0.72'; 12 $VERSION = eval $VERSION; # make the alpha version come out as a number 13 14 # Make Test::Builder thread-safe for ithreads. 15 BEGIN { 16 use Config; 17 # Load threads::shared when threads are turned on. 18 # 5.8.0's threads are so busted we no longer support them. 19 if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'}) { 20 require threads::shared; 21 22 # Hack around YET ANOTHER threads::shared bug. It would 23 # occassionally forget the contents of the variable when sharing it. 24 # So we first copy the data, then share, then put our copy back. 25 *share = sub (\[$@%]) { 26 my $type = ref $_[0]; 27 my $data; 28 29 if( $type eq 'HASH' ) { 30 %$data = %{$_[0]}; 31 } 32 elsif( $type eq 'ARRAY' ) { 33 @$data = @{$_[0]}; 34 } 35 elsif( $type eq 'SCALAR' ) { 36 $$data = ${$_[0]}; 37 } 38 else { 39 die("Unknown type: ".$type); 40 } 41 42 $_[0] = &threads::shared::share($_[0]); 43 44 if( $type eq 'HASH' ) { 45 %{$_[0]} = %$data; 46 } 47 elsif( $type eq 'ARRAY' ) { 48 @{$_[0]} = @$data; 49 } 50 elsif( $type eq 'SCALAR' ) { 51 ${$_[0]} = $$data; 52 } 53 else { 54 die("Unknown type: ".$type); 55 } 56 57 return $_[0]; 58 }; 59 } 60 # 5.8.0's threads::shared is busted when threads are off 61 # and earlier Perls just don't have that module at all. 62 else { 63 *share = sub { return $_[0] }; 64 *lock = sub { 0 }; 65 } 66 } 67 68 69 =head1 NAME 70 71 Test::Builder - Backend for building test libraries 72 73 =head1 SYNOPSIS 74 75 package My::Test::Module; 76 use Test::Builder; 77 require Exporter; 78 @ISA = qw(Exporter); 79 @EXPORT = qw(ok); 80 81 my $Test = Test::Builder->new; 82 $Test->output('my_logfile'); 83 84 sub import { 85 my($self) = shift; 86 my $pack = caller; 87 88 $Test->exported_to($pack); 89 $Test->plan(@_); 90 91 $self->export_to_level(1, $self, 'ok'); 92 } 93 94 sub ok { 95 my($test, $name) = @_; 96 97 $Test->ok($test, $name); 98 } 99 100 101 =head1 DESCRIPTION 102 103 Test::Simple and Test::More have proven to be popular testing modules, 104 but they're not always flexible enough. Test::Builder provides the a 105 building block upon which to write your own test libraries I<which can 106 work together>. 107 108 =head2 Construction 109 110 =over 4 111 112 =item B<new> 113 114 my $Test = Test::Builder->new; 115 116 Returns a Test::Builder object representing the current state of the 117 test. 118 119 Since you only run one test per program C<new> always returns the same 120 Test::Builder object. No matter how many times you call new(), you're 121 getting the same object. This is called a singleton. This is done so that 122 multiple modules share such global information as the test counter and 123 where test output is going. 124 125 If you want a completely new Test::Builder object different from the 126 singleton, use C<create>. 127 128 =cut 129 130 my $Test = Test::Builder->new; 131 sub new { 132 my($class) = shift; 133 $Test ||= $class->create; 134 return $Test; 135 } 136 137 138 =item B<create> 139 140 my $Test = Test::Builder->create; 141 142 Ok, so there can be more than one Test::Builder object and this is how 143 you get it. You might use this instead of C<new()> if you're testing 144 a Test::Builder based module, but otherwise you probably want C<new>. 145 146 B<NOTE>: the implementation is not complete. C<level>, for example, is 147 still shared amongst B<all> Test::Builder objects, even ones created using 148 this method. Also, the method name may change in the future. 149 150 =cut 151 152 sub create { 153 my $class = shift; 154 155 my $self = bless {}, $class; 156 $self->reset; 157 158 return $self; 159 } 160 161 =item B<reset> 162 163 $Test->reset; 164 165 Reinitializes the Test::Builder singleton to its original state. 166 Mostly useful for tests run in persistent environments where the same 167 test might be run multiple times in the same process. 168 169 =cut 170 171 use vars qw($Level); 172 173 sub reset { 174 my ($self) = @_; 175 176 # We leave this a global because it has to be localized and localizing 177 # hash keys is just asking for pain. Also, it was documented. 178 $Level = 1; 179 180 $self->{Test_Died} = 0; 181 $self->{Have_Plan} = 0; 182 $self->{No_Plan} = 0; 183 $self->{Original_Pid} = $$; 184 185 share($self->{Curr_Test}); 186 $self->{Curr_Test} = 0; 187 $self->{Test_Results} = &share([]); 188 189 $self->{Exported_To} = undef; 190 $self->{Expected_Tests} = 0; 191 192 $self->{Skip_All} = 0; 193 194 $self->{Use_Nums} = 1; 195 196 $self->{No_Header} = 0; 197 $self->{No_Ending} = 0; 198 199 $self->_dup_stdhandles unless $^C; 200 201 return undef; 202 } 203 204 =back 205 206 =head2 Setting up tests 207 208 These methods are for setting up tests and declaring how many there 209 are. You usually only want to call one of these methods. 210 211 =over 4 212 213 =item B<exported_to> 214 215 my $pack = $Test->exported_to; 216 $Test->exported_to($pack); 217 218 Tells Test::Builder what package you exported your functions to. 219 This is important for getting TODO tests right. 220 221 =cut 222 223 sub exported_to { 224 my($self, $pack) = @_; 225 226 if( defined $pack ) { 227 $self->{Exported_To} = $pack; 228 } 229 return $self->{Exported_To}; 230 } 231 232 =item B<plan> 233 234 $Test->plan('no_plan'); 235 $Test->plan( skip_all => $reason ); 236 $Test->plan( tests => $num_tests ); 237 238 A convenient way to set up your tests. Call this and Test::Builder 239 will print the appropriate headers and take the appropriate actions. 240 241 If you call plan(), don't call any of the other methods below. 242 243 =cut 244 245 sub plan { 246 my($self, $cmd, $arg) = @_; 247 248 return unless $cmd; 249 250 local $Level = $Level + 1; 251 252 if( $self->{Have_Plan} ) { 253 $self->croak("You tried to plan twice"); 254 } 255 256 if( $cmd eq 'no_plan' ) { 257 $self->no_plan; 258 } 259 elsif( $cmd eq 'skip_all' ) { 260 return $self->skip_all($arg); 261 } 262 elsif( $cmd eq 'tests' ) { 263 if( $arg ) { 264 local $Level = $Level + 1; 265 return $self->expected_tests($arg); 266 } 267 elsif( !defined $arg ) { 268 $self->croak("Got an undefined number of tests"); 269 } 270 elsif( !$arg ) { 271 $self->croak("You said to run 0 tests"); 272 } 273 } 274 else { 275 my @args = grep { defined } ($cmd, $arg); 276 $self->croak("plan() doesn't understand @args"); 277 } 278 279 return 1; 280 } 281 282 =item B<expected_tests> 283 284 my $max = $Test->expected_tests; 285 $Test->expected_tests($max); 286 287 Gets/sets the # of tests we expect this test to run and prints out 288 the appropriate headers. 289 290 =cut 291 292 sub expected_tests { 293 my $self = shift; 294 my($max) = @_; 295 296 if( @_ ) { 297 $self->croak("Number of tests must be a positive integer. You gave it '$max'") 298 unless $max =~ /^\+?\d+$/ and $max > 0; 299 300 $self->{Expected_Tests} = $max; 301 $self->{Have_Plan} = 1; 302 303 $self->_print("1..$max\n") unless $self->no_header; 304 } 305 return $self->{Expected_Tests}; 306 } 307 308 309 =item B<no_plan> 310 311 $Test->no_plan; 312 313 Declares that this test will run an indeterminate # of tests. 314 315 =cut 316 317 sub no_plan { 318 my $self = shift; 319 320 $self->{No_Plan} = 1; 321 $self->{Have_Plan} = 1; 322 } 323 324 =item B<has_plan> 325 326 $plan = $Test->has_plan 327 328 Find out whether a plan has been defined. $plan is either C<undef> (no plan has been set), C<no_plan> (indeterminate # of tests) or an integer (the number of expected tests). 329 330 =cut 331 332 sub has_plan { 333 my $self = shift; 334 335 return($self->{Expected_Tests}) if $self->{Expected_Tests}; 336 return('no_plan') if $self->{No_Plan}; 337 return(undef); 338 }; 339 340 341 =item B<skip_all> 342 343 $Test->skip_all; 344 $Test->skip_all($reason); 345 346 Skips all the tests, using the given $reason. Exits immediately with 0. 347 348 =cut 349 350 sub skip_all { 351 my($self, $reason) = @_; 352 353 my $out = "1..0"; 354 $out .= " # Skip $reason" if $reason; 355 $out .= "\n"; 356 357 $self->{Skip_All} = 1; 358 359 $self->_print($out) unless $self->no_header; 360 exit(0); 361 } 362 363 =back 364 365 =head2 Running tests 366 367 These actually run the tests, analogous to the functions in Test::More. 368 369 They all return true if the test passed, false if the test failed. 370 371 $name is always optional. 372 373 =over 4 374 375 =item B<ok> 376 377 $Test->ok($test, $name); 378 379 Your basic test. Pass if $test is true, fail if $test is false. Just 380 like Test::Simple's ok(). 381 382 =cut 383 384 sub ok { 385 my($self, $test, $name) = @_; 386 387 # $test might contain an object which we don't want to accidentally 388 # store, so we turn it into a boolean. 389 $test = $test ? 1 : 0; 390 391 $self->_plan_check; 392 393 lock $self->{Curr_Test}; 394 $self->{Curr_Test}++; 395 396 # In case $name is a string overloaded object, force it to stringify. 397 $self->_unoverload_str(\$name); 398 399 $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/; 400 You named your test '$name'. You shouldn't use numbers for your test names. 401 Very confusing. 402 ERR 403 404 my($pack, $file, $line) = $self->caller; 405 406 my $todo = $self->todo($pack); 407 $self->_unoverload_str(\$todo); 408 409 my $out; 410 my $result = &share({}); 411 412 unless( $test ) { 413 $out .= "not "; 414 @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 ); 415 } 416 else { 417 @$result{ 'ok', 'actual_ok' } = ( 1, $test ); 418 } 419 420 $out .= "ok"; 421 $out .= " $self->{Curr_Test}" if $self->use_numbers; 422 423 if( defined $name ) { 424 $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness. 425 $out .= " - $name"; 426 $result->{name} = $name; 427 } 428 else { 429 $result->{name} = ''; 430 } 431 432 if( $todo ) { 433 $out .= " # TODO $todo"; 434 $result->{reason} = $todo; 435 $result->{type} = 'todo'; 436 } 437 else { 438 $result->{reason} = ''; 439 $result->{type} = ''; 440 } 441 442 $self->{Test_Results}[$self->{Curr_Test}-1] = $result; 443 $out .= "\n"; 444 445 $self->_print($out); 446 447 unless( $test ) { 448 my $msg = $todo ? "Failed (TODO)" : "Failed"; 449 $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE}; 450 451 if( defined $name ) { 452 $self->diag(qq[ $msg test '$name'\n]); 453 $self->diag(qq[ at $file line $line.\n]); 454 } 455 else { 456 $self->diag(qq[ $msg test at $file line $line.\n]); 457 } 458 } 459 460 return $test ? 1 : 0; 461 } 462 463 464 sub _unoverload { 465 my $self = shift; 466 my $type = shift; 467 468 $self->_try(sub { require overload } ) || return; 469 470 foreach my $thing (@_) { 471 if( $self->_is_object($$thing) ) { 472 if( my $string_meth = overload::Method($$thing, $type) ) { 473 $$thing = $$thing->$string_meth(); 474 } 475 } 476 } 477 } 478 479 480 sub _is_object { 481 my($self, $thing) = @_; 482 483 return $self->_try(sub { ref $thing && $thing->isa('UNIVERSAL') }) ? 1 : 0; 484 } 485 486 487 sub _unoverload_str { 488 my $self = shift; 489 490 $self->_unoverload(q[""], @_); 491 } 492 493 sub _unoverload_num { 494 my $self = shift; 495 496 $self->_unoverload('0+', @_); 497 498 for my $val (@_) { 499 next unless $self->_is_dualvar($$val); 500 $$val = $$val+0; 501 } 502 } 503 504 505 # This is a hack to detect a dualvar such as $! 506 sub _is_dualvar { 507 my($self, $val) = @_; 508 509 local $^W = 0; 510 my $numval = $val+0; 511 return 1 if $numval != 0 and $numval ne $val; 512 } 513 514 515 516 =item B<is_eq> 517 518 $Test->is_eq($got, $expected, $name); 519 520 Like Test::More's is(). Checks if $got eq $expected. This is the 521 string version. 522 523 =item B<is_num> 524 525 $Test->is_num($got, $expected, $name); 526 527 Like Test::More's is(). Checks if $got == $expected. This is the 528 numeric version. 529 530 =cut 531 532 sub is_eq { 533 my($self, $got, $expect, $name) = @_; 534 local $Level = $Level + 1; 535 536 $self->_unoverload_str(\$got, \$expect); 537 538 if( !defined $got || !defined $expect ) { 539 # undef only matches undef and nothing else 540 my $test = !defined $got && !defined $expect; 541 542 $self->ok($test, $name); 543 $self->_is_diag($got, 'eq', $expect) unless $test; 544 return $test; 545 } 546 547 return $self->cmp_ok($got, 'eq', $expect, $name); 548 } 549 550 sub is_num { 551 my($self, $got, $expect, $name) = @_; 552 local $Level = $Level + 1; 553 554 $self->_unoverload_num(\$got, \$expect); 555 556 if( !defined $got || !defined $expect ) { 557 # undef only matches undef and nothing else 558 my $test = !defined $got && !defined $expect; 559 560 $self->ok($test, $name); 561 $self->_is_diag($got, '==', $expect) unless $test; 562 return $test; 563 } 564 565 return $self->cmp_ok($got, '==', $expect, $name); 566 } 567 568 sub _is_diag { 569 my($self, $got, $type, $expect) = @_; 570 571 foreach my $val (\$got, \$expect) { 572 if( defined $$val ) { 573 if( $type eq 'eq' ) { 574 # quote and force string context 575 $$val = "'$$val'" 576 } 577 else { 578 # force numeric context 579 $self->_unoverload_num($val); 580 } 581 } 582 else { 583 $$val = 'undef'; 584 } 585 } 586 587 return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect); 588 got: %s 589 expected: %s 590 DIAGNOSTIC 591 592 } 593 594 =item B<isnt_eq> 595 596 $Test->isnt_eq($got, $dont_expect, $name); 597 598 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is 599 the string version. 600 601 =item B<isnt_num> 602 603 $Test->isnt_num($got, $dont_expect, $name); 604 605 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is 606 the numeric version. 607 608 =cut 609 610 sub isnt_eq { 611 my($self, $got, $dont_expect, $name) = @_; 612 local $Level = $Level + 1; 613 614 if( !defined $got || !defined $dont_expect ) { 615 # undef only matches undef and nothing else 616 my $test = defined $got || defined $dont_expect; 617 618 $self->ok($test, $name); 619 $self->_cmp_diag($got, 'ne', $dont_expect) unless $test; 620 return $test; 621 } 622 623 return $self->cmp_ok($got, 'ne', $dont_expect, $name); 624 } 625 626 sub isnt_num { 627 my($self, $got, $dont_expect, $name) = @_; 628 local $Level = $Level + 1; 629 630 if( !defined $got || !defined $dont_expect ) { 631 # undef only matches undef and nothing else 632 my $test = defined $got || defined $dont_expect; 633 634 $self->ok($test, $name); 635 $self->_cmp_diag($got, '!=', $dont_expect) unless $test; 636 return $test; 637 } 638 639 return $self->cmp_ok($got, '!=', $dont_expect, $name); 640 } 641 642 643 =item B<like> 644 645 $Test->like($this, qr/$regex/, $name); 646 $Test->like($this, '/$regex/', $name); 647 648 Like Test::More's like(). Checks if $this matches the given $regex. 649 650 You'll want to avoid qr// if you want your tests to work before 5.005. 651 652 =item B<unlike> 653 654 $Test->unlike($this, qr/$regex/, $name); 655 $Test->unlike($this, '/$regex/', $name); 656 657 Like Test::More's unlike(). Checks if $this B<does not match> the 658 given $regex. 659 660 =cut 661 662 sub like { 663 my($self, $this, $regex, $name) = @_; 664 665 local $Level = $Level + 1; 666 $self->_regex_ok($this, $regex, '=~', $name); 667 } 668 669 sub unlike { 670 my($self, $this, $regex, $name) = @_; 671 672 local $Level = $Level + 1; 673 $self->_regex_ok($this, $regex, '!~', $name); 674 } 675 676 677 =item B<cmp_ok> 678 679 $Test->cmp_ok($this, $type, $that, $name); 680 681 Works just like Test::More's cmp_ok(). 682 683 $Test->cmp_ok($big_num, '!=', $other_big_num); 684 685 =cut 686 687 688 my %numeric_cmps = map { ($_, 1) } 689 ("<", "<=", ">", ">=", "==", "!=", "<=>"); 690 691 sub cmp_ok { 692 my($self, $got, $type, $expect, $name) = @_; 693 694 # Treat overloaded objects as numbers if we're asked to do a 695 # numeric comparison. 696 my $unoverload = $numeric_cmps{$type} ? '_unoverload_num' 697 : '_unoverload_str'; 698 699 $self->$unoverload(\$got, \$expect); 700 701 702 my $test; 703 { 704 local($@,$!,$SIG{__DIE__}); # isolate eval 705 706 my $code = $self->_caller_context; 707 708 # Yes, it has to look like this or 5.4.5 won't see the #line directive. 709 # Don't ask me, man, I just work here. 710 $test = eval " 711 $code" . "\$got $type \$expect;"; 712 713 } 714 local $Level = $Level + 1; 715 my $ok = $self->ok($test, $name); 716 717 unless( $ok ) { 718 if( $type =~ /^(eq|==)$/ ) { 719 $self->_is_diag($got, $type, $expect); 720 } 721 else { 722 $self->_cmp_diag($got, $type, $expect); 723 } 724 } 725 return $ok; 726 } 727 728 sub _cmp_diag { 729 my($self, $got, $type, $expect) = @_; 730 731 $got = defined $got ? "'$got'" : 'undef'; 732 $expect = defined $expect ? "'$expect'" : 'undef'; 733 return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect); 734 %s 735 %s 736 %s 737 DIAGNOSTIC 738 } 739 740 741 sub _caller_context { 742 my $self = shift; 743 744 my($pack, $file, $line) = $self->caller(1); 745 746 my $code = ''; 747 $code .= "#line $line $file\n" if defined $file and defined $line; 748 749 return $code; 750 } 751 752 =back 753 754 755 =head2 Other Testing Methods 756 757 These are methods which are used in the course of writing a test but are not themselves tests. 758 759 =over 4 760 761 =item B<BAIL_OUT> 762 763 $Test->BAIL_OUT($reason); 764 765 Indicates to the Test::Harness that things are going so badly all 766 testing should terminate. This includes running any additional test 767 scripts. 768 769 It will exit with 255. 770 771 =cut 772 773 sub BAIL_OUT { 774 my($self, $reason) = @_; 775 776 $self->{Bailed_Out} = 1; 777 $self->_print("Bail out! $reason"); 778 exit 255; 779 } 780 781 =for deprecated 782 BAIL_OUT() used to be BAILOUT() 783 784 =cut 785 786 *BAILOUT = \&BAIL_OUT; 787 788 789 =item B<skip> 790 791 $Test->skip; 792 $Test->skip($why); 793 794 Skips the current test, reporting $why. 795 796 =cut 797 798 sub skip { 799 my($self, $why) = @_; 800 $why ||= ''; 801 $self->_unoverload_str(\$why); 802 803 $self->_plan_check; 804 805 lock($self->{Curr_Test}); 806 $self->{Curr_Test}++; 807 808 $self->{Test_Results}[$self->{Curr_Test}-1] = &share({ 809 'ok' => 1, 810 actual_ok => 1, 811 name => '', 812 type => 'skip', 813 reason => $why, 814 }); 815 816 my $out = "ok"; 817 $out .= " $self->{Curr_Test}" if $self->use_numbers; 818 $out .= " # skip"; 819 $out .= " $why" if length $why; 820 $out .= "\n"; 821 822 $self->_print($out); 823 824 return 1; 825 } 826 827 828 =item B<todo_skip> 829 830 $Test->todo_skip; 831 $Test->todo_skip($why); 832 833 Like skip(), only it will declare the test as failing and TODO. Similar 834 to 835 836 print "not ok $tnum # TODO $why\n"; 837 838 =cut 839 840 sub todo_skip { 841 my($self, $why) = @_; 842 $why ||= ''; 843 844 $self->_plan_check; 845 846 lock($self->{Curr_Test}); 847 $self->{Curr_Test}++; 848 849 $self->{Test_Results}[$self->{Curr_Test}-1] = &share({ 850 'ok' => 1, 851 actual_ok => 0, 852 name => '', 853 type => 'todo_skip', 854 reason => $why, 855 }); 856 857 my $out = "not ok"; 858 $out .= " $self->{Curr_Test}" if $self->use_numbers; 859 $out .= " # TODO & SKIP $why\n"; 860 861 $self->_print($out); 862 863 return 1; 864 } 865 866 867 =begin _unimplemented 868 869 =item B<skip_rest> 870 871 $Test->skip_rest; 872 $Test->skip_rest($reason); 873 874 Like skip(), only it skips all the rest of the tests you plan to run 875 and terminates the test. 876 877 If you're running under no_plan, it skips once and terminates the 878 test. 879 880 =end _unimplemented 881 882 =back 883 884 885 =head2 Test building utility methods 886 887 These methods are useful when writing your own test methods. 888 889 =over 4 890 891 =item B<maybe_regex> 892 893 $Test->maybe_regex(qr/$regex/); 894 $Test->maybe_regex('/$regex/'); 895 896 Convenience method for building testing functions that take regular 897 expressions as arguments, but need to work before perl 5.005. 898 899 Takes a quoted regular expression produced by qr//, or a string 900 representing a regular expression. 901 902 Returns a Perl value which may be used instead of the corresponding 903 regular expression, or undef if it's argument is not recognised. 904 905 For example, a version of like(), sans the useful diagnostic messages, 906 could be written as: 907 908 sub laconic_like { 909 my ($self, $this, $regex, $name) = @_; 910 my $usable_regex = $self->maybe_regex($regex); 911 die "expecting regex, found '$regex'\n" 912 unless $usable_regex; 913 $self->ok($this =~ m/$usable_regex/, $name); 914 } 915 916 =cut 917 918 919 sub maybe_regex { 920 my ($self, $regex) = @_; 921 my $usable_regex = undef; 922 923 return $usable_regex unless defined $regex; 924 925 my($re, $opts); 926 927 # Check for qr/foo/ 928 if( ref $regex eq 'Regexp' ) { 929 $usable_regex = $regex; 930 } 931 # Check for '/foo/' or 'm,foo,' 932 elsif( ($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or 933 (undef, $re, $opts) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx 934 ) 935 { 936 $usable_regex = length $opts ? "(?$opts)$re" : $re; 937 } 938 939 return $usable_regex; 940 }; 941 942 sub _regex_ok { 943 my($self, $this, $regex, $cmp, $name) = @_; 944 945 my $ok = 0; 946 my $usable_regex = $self->maybe_regex($regex); 947 unless (defined $usable_regex) { 948 $ok = $self->ok( 0, $name ); 949 $self->diag(" '$regex' doesn't look much like a regex to me."); 950 return $ok; 951 } 952 953 { 954 my $test; 955 my $code = $self->_caller_context; 956 957 local($@, $!, $SIG{__DIE__}); # isolate eval 958 959 # Yes, it has to look like this or 5.4.5 won't see the #line directive. 960 # Don't ask me, man, I just work here. 961 $test = eval " 962 $code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0}; 963 964 $test = !$test if $cmp eq '!~'; 965 966 local $Level = $Level + 1; 967 $ok = $self->ok( $test, $name ); 968 } 969 970 unless( $ok ) { 971 $this = defined $this ? "'$this'" : 'undef'; 972 my $match = $cmp eq '=~' ? "doesn't match" : "matches"; 973 $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex); 974 %s 975 %13s '%s' 976 DIAGNOSTIC 977 978 } 979 980 return $ok; 981 } 982 983 984 # I'm not ready to publish this. It doesn't deal with array return 985 # values from the code or context. 986 987 =begin private 988 989 =item B<_try> 990 991 my $return_from_code = $Test->try(sub { code }); 992 my($return_from_code, $error) = $Test->try(sub { code }); 993 994 Works like eval BLOCK except it ensures it has no effect on the rest of the test (ie. $@ is not set) nor is effected by outside interference (ie. $SIG{__DIE__}) and works around some quirks in older Perls. 995 996 $error is what would normally be in $@. 997 998 It is suggested you use this in place of eval BLOCK. 999 1000 =cut 1001 1002 sub _try { 1003 my($self, $code) = @_; 1004 1005 local $!; # eval can mess up $! 1006 local $@; # don't set $@ in the test 1007 local $SIG{__DIE__}; # don't trip an outside DIE handler. 1008 my $return = eval { $code->() }; 1009 1010 return wantarray ? ($return, $@) : $return; 1011 } 1012 1013 =end private 1014 1015 1016 =item B<is_fh> 1017 1018 my $is_fh = $Test->is_fh($thing); 1019 1020 Determines if the given $thing can be used as a filehandle. 1021 1022 =cut 1023 1024 sub is_fh { 1025 my $self = shift; 1026 my $maybe_fh = shift; 1027 return 0 unless defined $maybe_fh; 1028 1029 return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref 1030 return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob 1031 1032 return eval { $maybe_fh->isa("IO::Handle") } || 1033 # 5.5.4's tied() and can() doesn't like getting undef 1034 eval { (tied($maybe_fh) || '')->can('TIEHANDLE') }; 1035 } 1036 1037 1038 =back 1039 1040 1041 =head2 Test style 1042 1043 1044 =over 4 1045 1046 =item B<level> 1047 1048 $Test->level($how_high); 1049 1050 How far up the call stack should $Test look when reporting where the 1051 test failed. 1052 1053 Defaults to 1. 1054 1055 Setting L<$Test::Builder::Level> overrides. This is typically useful 1056 localized: 1057 1058 sub my_ok { 1059 my $test = shift; 1060 1061 local $Test::Builder::Level = $Test::Builder::Level + 1; 1062 $TB->ok($test); 1063 } 1064 1065 To be polite to other functions wrapping your own you usually want to increment C<$Level> rather than set it to a constant. 1066 1067 =cut 1068 1069 sub level { 1070 my($self, $level) = @_; 1071 1072 if( defined $level ) { 1073 $Level = $level; 1074 } 1075 return $Level; 1076 } 1077 1078 1079 =item B<use_numbers> 1080 1081 $Test->use_numbers($on_or_off); 1082 1083 Whether or not the test should output numbers. That is, this if true: 1084 1085 ok 1 1086 ok 2 1087 ok 3 1088 1089 or this if false 1090 1091 ok 1092 ok 1093 ok 1094 1095 Most useful when you can't depend on the test output order, such as 1096 when threads or forking is involved. 1097 1098 Defaults to on. 1099 1100 =cut 1101 1102 sub use_numbers { 1103 my($self, $use_nums) = @_; 1104 1105 if( defined $use_nums ) { 1106 $self->{Use_Nums} = $use_nums; 1107 } 1108 return $self->{Use_Nums}; 1109 } 1110 1111 1112 =item B<no_diag> 1113 1114 $Test->no_diag($no_diag); 1115 1116 If set true no diagnostics will be printed. This includes calls to 1117 diag(). 1118 1119 =item B<no_ending> 1120 1121 $Test->no_ending($no_ending); 1122 1123 Normally, Test::Builder does some extra diagnostics when the test 1124 ends. It also changes the exit code as described below. 1125 1126 If this is true, none of that will be done. 1127 1128 =item B<no_header> 1129 1130 $Test->no_header($no_header); 1131 1132 If set to true, no "1..N" header will be printed. 1133 1134 =cut 1135 1136 foreach my $attribute (qw(No_Header No_Ending No_Diag)) { 1137 my $method = lc $attribute; 1138 1139 my $code = sub { 1140 my($self, $no) = @_; 1141 1142 if( defined $no ) { 1143 $self->{$attribute} = $no; 1144 } 1145 return $self->{$attribute}; 1146 }; 1147 1148 no strict 'refs'; 1149 *{__PACKAGE__.'::'.$method} = $code; 1150 } 1151 1152 1153 =back 1154 1155 =head2 Output 1156 1157 Controlling where the test output goes. 1158 1159 It's ok for your test to change where STDOUT and STDERR point to, 1160 Test::Builder's default output settings will not be affected. 1161 1162 =over 4 1163 1164 =item B<diag> 1165 1166 $Test->diag(@msgs); 1167 1168 Prints out the given @msgs. Like C<print>, arguments are simply 1169 appended together. 1170 1171 Normally, it uses the failure_output() handle, but if this is for a 1172 TODO test, the todo_output() handle is used. 1173 1174 Output will be indented and marked with a # so as not to interfere 1175 with test output. A newline will be put on the end if there isn't one 1176 already. 1177 1178 We encourage using this rather than calling print directly. 1179 1180 Returns false. Why? Because diag() is often used in conjunction with 1181 a failing test (C<ok() || diag()>) it "passes through" the failure. 1182 1183 return ok(...) || diag(...); 1184 1185 =for blame transfer 1186 Mark Fowler <mark@twoshortplanks.com> 1187 1188 =cut 1189 1190 sub diag { 1191 my($self, @msgs) = @_; 1192 1193 return if $self->no_diag; 1194 return unless @msgs; 1195 1196 # Prevent printing headers when compiling (i.e. -c) 1197 return if $^C; 1198 1199 # Smash args together like print does. 1200 # Convert undef to 'undef' so its readable. 1201 my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs; 1202 1203 # Escape each line with a #. 1204 $msg =~ s/^/# /gm; 1205 1206 # Stick a newline on the end if it needs it. 1207 $msg .= "\n" unless $msg =~ /\n\Z/; 1208 1209 local $Level = $Level + 1; 1210 $self->_print_diag($msg); 1211 1212 return 0; 1213 } 1214 1215 =begin _private 1216 1217 =item B<_print> 1218 1219 $Test->_print(@msgs); 1220 1221 Prints to the output() filehandle. 1222 1223 =end _private 1224 1225 =cut 1226 1227 sub _print { 1228 my($self, @msgs) = @_; 1229 1230 # Prevent printing headers when only compiling. Mostly for when 1231 # tests are deparsed with B::Deparse 1232 return if $^C; 1233 1234 my $msg = join '', @msgs; 1235 1236 local($\, $", $,) = (undef, ' ', ''); 1237 my $fh = $self->output; 1238 1239 # Escape each line after the first with a # so we don't 1240 # confuse Test::Harness. 1241 $msg =~ s/\n(.)/\n# $1/sg; 1242 1243 # Stick a newline on the end if it needs it. 1244 $msg .= "\n" unless $msg =~ /\n\Z/; 1245 1246 print $fh $msg; 1247 } 1248 1249 =begin private 1250 1251 =item B<_print_diag> 1252 1253 $Test->_print_diag(@msg); 1254 1255 Like _print, but prints to the current diagnostic filehandle. 1256 1257 =end private 1258 1259 =cut 1260 1261 sub _print_diag { 1262 my $self = shift; 1263 1264 local($\, $", $,) = (undef, ' ', ''); 1265 my $fh = $self->todo ? $self->todo_output : $self->failure_output; 1266 print $fh @_; 1267 } 1268 1269 =item B<output> 1270 1271 $Test->output($fh); 1272 $Test->output($file); 1273 1274 Where normal "ok/not ok" test output should go. 1275 1276 Defaults to STDOUT. 1277 1278 =item B<failure_output> 1279 1280 $Test->failure_output($fh); 1281 $Test->failure_output($file); 1282 1283 Where diagnostic output on test failures and diag() should go. 1284 1285 Defaults to STDERR. 1286 1287 =item B<todo_output> 1288 1289 $Test->todo_output($fh); 1290 $Test->todo_output($file); 1291 1292 Where diagnostics about todo test failures and diag() should go. 1293 1294 Defaults to STDOUT. 1295 1296 =cut 1297 1298 sub output { 1299 my($self, $fh) = @_; 1300 1301 if( defined $fh ) { 1302 $self->{Out_FH} = $self->_new_fh($fh); 1303 } 1304 return $self->{Out_FH}; 1305 } 1306 1307 sub failure_output { 1308 my($self, $fh) = @_; 1309 1310 if( defined $fh ) { 1311 $self->{Fail_FH} = $self->_new_fh($fh); 1312 } 1313 return $self->{Fail_FH}; 1314 } 1315 1316 sub todo_output { 1317 my($self, $fh) = @_; 1318 1319 if( defined $fh ) { 1320 $self->{Todo_FH} = $self->_new_fh($fh); 1321 } 1322 return $self->{Todo_FH}; 1323 } 1324 1325 1326 sub _new_fh { 1327 my $self = shift; 1328 my($file_or_fh) = shift; 1329 1330 my $fh; 1331 if( $self->is_fh($file_or_fh) ) { 1332 $fh = $file_or_fh; 1333 } 1334 else { 1335 $fh = do { local *FH }; 1336 open $fh, ">$file_or_fh" or 1337 $self->croak("Can't open test output log $file_or_fh: $!"); 1338 _autoflush($fh); 1339 } 1340 1341 return $fh; 1342 } 1343 1344 1345 sub _autoflush { 1346 my($fh) = shift; 1347 my $old_fh = select $fh; 1348 $| = 1; 1349 select $old_fh; 1350 } 1351 1352 1353 sub _dup_stdhandles { 1354 my $self = shift; 1355 1356 $self->_open_testhandles; 1357 1358 # Set everything to unbuffered else plain prints to STDOUT will 1359 # come out in the wrong order from our own prints. 1360 _autoflush(\*TESTOUT); 1361 _autoflush(\*STDOUT); 1362 _autoflush(\*TESTERR); 1363 _autoflush(\*STDERR); 1364 1365 $self->output(\*TESTOUT); 1366 $self->failure_output(\*TESTERR); 1367 $self->todo_output(\*TESTOUT); 1368 } 1369 1370 1371 my $Opened_Testhandles = 0; 1372 sub _open_testhandles { 1373 return if $Opened_Testhandles; 1374 # We dup STDOUT and STDERR so people can change them in their 1375 # test suites while still getting normal test output. 1376 open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!"; 1377 open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!"; 1378 $Opened_Testhandles = 1; 1379 } 1380 1381 1382 =item carp 1383 1384 $tb->carp(@message); 1385 1386 Warns with C<@message> but the message will appear to come from the 1387 point where the original test function was called (C<$tb->caller>). 1388 1389 =item croak 1390 1391 $tb->croak(@message); 1392 1393 Dies with C<@message> but the message will appear to come from the 1394 point where the original test function was called (C<$tb->caller>). 1395 1396 =cut 1397 1398 sub _message_at_caller { 1399 my $self = shift; 1400 1401 local $Level = $Level + 1; 1402 my($pack, $file, $line) = $self->caller; 1403 return join("", @_) . " at $file line $line.\n"; 1404 } 1405 1406 sub carp { 1407 my $self = shift; 1408 warn $self->_message_at_caller(@_); 1409 } 1410 1411 sub croak { 1412 my $self = shift; 1413 die $self->_message_at_caller(@_); 1414 } 1415 1416 sub _plan_check { 1417 my $self = shift; 1418 1419 unless( $self->{Have_Plan} ) { 1420 local $Level = $Level + 2; 1421 $self->croak("You tried to run a test without a plan"); 1422 } 1423 } 1424 1425 =back 1426 1427 1428 =head2 Test Status and Info 1429 1430 =over 4 1431 1432 =item B<current_test> 1433 1434 my $curr_test = $Test->current_test; 1435 $Test->current_test($num); 1436 1437 Gets/sets the current test number we're on. You usually shouldn't 1438 have to set this. 1439 1440 If set forward, the details of the missing tests are filled in as 'unknown'. 1441 if set backward, the details of the intervening tests are deleted. You 1442 can erase history if you really want to. 1443 1444 =cut 1445 1446 sub current_test { 1447 my($self, $num) = @_; 1448 1449 lock($self->{Curr_Test}); 1450 if( defined $num ) { 1451 unless( $self->{Have_Plan} ) { 1452 $self->croak("Can't change the current test number without a plan!"); 1453 } 1454 1455 $self->{Curr_Test} = $num; 1456 1457 # If the test counter is being pushed forward fill in the details. 1458 my $test_results = $self->{Test_Results}; 1459 if( $num > @$test_results ) { 1460 my $start = @$test_results ? @$test_results : 0; 1461 for ($start..$num-1) { 1462 $test_results->[$_] = &share({ 1463 'ok' => 1, 1464 actual_ok => undef, 1465 reason => 'incrementing test number', 1466 type => 'unknown', 1467 name => undef 1468 }); 1469 } 1470 } 1471 # If backward, wipe history. Its their funeral. 1472 elsif( $num < @$test_results ) { 1473 $#{$test_results} = $num - 1; 1474 } 1475 } 1476 return $self->{Curr_Test}; 1477 } 1478 1479 1480 =item B<summary> 1481 1482 my @tests = $Test->summary; 1483 1484 A simple summary of the tests so far. True for pass, false for fail. 1485 This is a logical pass/fail, so todos are passes. 1486 1487 Of course, test #1 is $tests[0], etc... 1488 1489 =cut 1490 1491 sub summary { 1492 my($self) = shift; 1493 1494 return map { $_->{'ok'} } @{ $self->{Test_Results} }; 1495 } 1496 1497 =item B<details> 1498 1499 my @tests = $Test->details; 1500 1501 Like summary(), but with a lot more detail. 1502 1503 $tests[$test_num - 1] = 1504 { 'ok' => is the test considered a pass? 1505 actual_ok => did it literally say 'ok'? 1506 name => name of the test (if any) 1507 type => type of test (if any, see below). 1508 reason => reason for the above (if any) 1509 }; 1510 1511 'ok' is true if Test::Harness will consider the test to be a pass. 1512 1513 'actual_ok' is a reflection of whether or not the test literally 1514 printed 'ok' or 'not ok'. This is for examining the result of 'todo' 1515 tests. 1516 1517 'name' is the name of the test. 1518 1519 'type' indicates if it was a special test. Normal tests have a type 1520 of ''. Type can be one of the following: 1521 1522 skip see skip() 1523 todo see todo() 1524 todo_skip see todo_skip() 1525 unknown see below 1526 1527 Sometimes the Test::Builder test counter is incremented without it 1528 printing any test output, for example, when current_test() is changed. 1529 In these cases, Test::Builder doesn't know the result of the test, so 1530 it's type is 'unkown'. These details for these tests are filled in. 1531 They are considered ok, but the name and actual_ok is left undef. 1532 1533 For example "not ok 23 - hole count # TODO insufficient donuts" would 1534 result in this structure: 1535 1536 $tests[22] = # 23 - 1, since arrays start from 0. 1537 { ok => 1, # logically, the test passed since it's todo 1538 actual_ok => 0, # in absolute terms, it failed 1539 name => 'hole count', 1540 type => 'todo', 1541 reason => 'insufficient donuts' 1542 }; 1543 1544 =cut 1545 1546 sub details { 1547 my $self = shift; 1548 return @{ $self->{Test_Results} }; 1549 } 1550 1551 =item B<todo> 1552 1553 my $todo_reason = $Test->todo; 1554 my $todo_reason = $Test->todo($pack); 1555 1556 todo() looks for a $TODO variable in your tests. If set, all tests 1557 will be considered 'todo' (see Test::More and Test::Harness for 1558 details). Returns the reason (ie. the value of $TODO) if running as 1559 todo tests, false otherwise. 1560 1561 todo() is about finding the right package to look for $TODO in. It 1562 uses the exported_to() package to find it. If that's not set, it's 1563 pretty good at guessing the right package to look at based on $Level. 1564 1565 Sometimes there is some confusion about where todo() should be looking 1566 for the $TODO variable. If you want to be sure, tell it explicitly 1567 what $pack to use. 1568 1569 =cut 1570 1571 sub todo { 1572 my($self, $pack) = @_; 1573 1574 $pack = $pack || $self->exported_to || $self->caller($Level); 1575 return 0 unless $pack; 1576 1577 no strict 'refs'; 1578 return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'} 1579 : 0; 1580 } 1581 1582 =item B<caller> 1583 1584 my $package = $Test->caller; 1585 my($pack, $file, $line) = $Test->caller; 1586 my($pack, $file, $line) = $Test->caller($height); 1587 1588 Like the normal caller(), except it reports according to your level(). 1589 1590 =cut 1591 1592 sub caller { 1593 my($self, $height) = @_; 1594 $height ||= 0; 1595 1596 my @caller = CORE::caller($self->level + $height + 1); 1597 return wantarray ? @caller : $caller[0]; 1598 } 1599 1600 =back 1601 1602 =cut 1603 1604 =begin _private 1605 1606 =over 4 1607 1608 =item B<_sanity_check> 1609 1610 $self->_sanity_check(); 1611 1612 Runs a bunch of end of test sanity checks to make sure reality came 1613 through ok. If anything is wrong it will die with a fairly friendly 1614 error message. 1615 1616 =cut 1617 1618 #'# 1619 sub _sanity_check { 1620 my $self = shift; 1621 1622 $self->_whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!'); 1623 $self->_whoa(!$self->{Have_Plan} and $self->{Curr_Test}, 1624 'Somehow your tests ran without a plan!'); 1625 $self->_whoa($self->{Curr_Test} != @{ $self->{Test_Results} }, 1626 'Somehow you got a different number of results than tests ran!'); 1627 } 1628 1629 =item B<_whoa> 1630 1631 $self->_whoa($check, $description); 1632 1633 A sanity check, similar to assert(). If the $check is true, something 1634 has gone horribly wrong. It will die with the given $description and 1635 a note to contact the author. 1636 1637 =cut 1638 1639 sub _whoa { 1640 my($self, $check, $desc) = @_; 1641 if( $check ) { 1642 local $Level = $Level + 1; 1643 $self->croak(<<"WHOA"); 1644 WHOA! $desc 1645 This should never happen! Please contact the author immediately! 1646 WHOA 1647 } 1648 } 1649 1650 =item B<_my_exit> 1651 1652 _my_exit($exit_num); 1653 1654 Perl seems to have some trouble with exiting inside an END block. 5.005_03 1655 and 5.6.1 both seem to do odd things. Instead, this function edits $? 1656 directly. It should ONLY be called from inside an END block. It 1657 doesn't actually exit, that's your job. 1658 1659 =cut 1660 1661 sub _my_exit { 1662 $? = $_[0]; 1663 1664 return 1; 1665 } 1666 1667 1668 =back 1669 1670 =end _private 1671 1672 =cut 1673 1674 $SIG{__DIE__} = sub { 1675 # We don't want to muck with death in an eval, but $^S isn't 1676 # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing 1677 # with it. Instead, we use caller. This also means it runs under 1678 # 5.004! 1679 my $in_eval = 0; 1680 for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) { 1681 $in_eval = 1 if $sub =~ /^\(eval\)/; 1682 } 1683 $Test->{Test_Died} = 1 unless $in_eval; 1684 }; 1685 1686 sub _ending { 1687 my $self = shift; 1688 1689 $self->_sanity_check(); 1690 1691 # Don't bother with an ending if this is a forked copy. Only the parent 1692 # should do the ending. 1693 # Exit if plan() was never called. This is so "require Test::Simple" 1694 # doesn't puke. 1695 # Don't do an ending if we bailed out. 1696 if( ($self->{Original_Pid} != $$) or 1697 (!$self->{Have_Plan} && !$self->{Test_Died}) or 1698 $self->{Bailed_Out} 1699 ) 1700 { 1701 _my_exit($?); 1702 return; 1703 } 1704 1705 # Figure out if we passed or failed and print helpful messages. 1706 my $test_results = $self->{Test_Results}; 1707 if( @$test_results ) { 1708 # The plan? We have no plan. 1709 if( $self->{No_Plan} ) { 1710 $self->_print("1..$self->{Curr_Test}\n") unless $self->no_header; 1711 $self->{Expected_Tests} = $self->{Curr_Test}; 1712 } 1713 1714 # Auto-extended arrays and elements which aren't explicitly 1715 # filled in with a shared reference will puke under 5.8.0 1716 # ithreads. So we have to fill them in by hand. :( 1717 my $empty_result = &share({}); 1718 for my $idx ( 0..$self->{Expected_Tests}-1 ) { 1719 $test_results->[$idx] = $empty_result 1720 unless defined $test_results->[$idx]; 1721 } 1722 1723 my $num_failed = grep !$_->{'ok'}, 1724 @{$test_results}[0..$self->{Curr_Test}-1]; 1725 1726 my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests}; 1727 1728 if( $num_extra < 0 ) { 1729 my $s = $self->{Expected_Tests} == 1 ? '' : 's'; 1730 $self->diag(<<"FAIL"); 1731 Looks like you planned $self->{Expected_Tests} test$s but only ran $self->{Curr_Test}. 1732 FAIL 1733 } 1734 elsif( $num_extra > 0 ) { 1735 my $s = $self->{Expected_Tests} == 1 ? '' : 's'; 1736 $self->diag(<<"FAIL"); 1737 Looks like you planned $self->{Expected_Tests} test$s but ran $num_extra extra. 1738 FAIL 1739 } 1740 1741 if ( $num_failed ) { 1742 my $num_tests = $self->{Curr_Test}; 1743 my $s = $num_failed == 1 ? '' : 's'; 1744 1745 my $qualifier = $num_extra == 0 ? '' : ' run'; 1746 1747 $self->diag(<<"FAIL"); 1748 Looks like you failed $num_failed test$s of $num_tests$qualifier. 1749 FAIL 1750 } 1751 1752 if( $self->{Test_Died} ) { 1753 $self->diag(<<"FAIL"); 1754 Looks like your test died just after $self->{Curr_Test}. 1755 FAIL 1756 1757 _my_exit( 255 ) && return; 1758 } 1759 1760 my $exit_code; 1761 if( $num_failed ) { 1762 $exit_code = $num_failed <= 254 ? $num_failed : 254; 1763 } 1764 elsif( $num_extra != 0 ) { 1765 $exit_code = 255; 1766 } 1767 else { 1768 $exit_code = 0; 1769 } 1770 1771 _my_exit( $exit_code ) && return; 1772 } 1773 elsif ( $self->{Skip_All} ) { 1774 _my_exit( 0 ) && return; 1775 } 1776 elsif ( $self->{Test_Died} ) { 1777 $self->diag(<<'FAIL'); 1778 Looks like your test died before it could output anything. 1779 FAIL 1780 _my_exit( 255 ) && return; 1781 } 1782 else { 1783 $self->diag("No tests run!\n"); 1784 _my_exit( 255 ) && return; 1785 } 1786 } 1787 1788 END { 1789 $Test->_ending if defined $Test and !$Test->no_ending; 1790 } 1791 1792 =head1 EXIT CODES 1793 1794 If all your tests passed, Test::Builder will exit with zero (which is 1795 normal). If anything failed it will exit with how many failed. If 1796 you run less (or more) tests than you planned, the missing (or extras) 1797 will be considered failures. If no tests were ever run Test::Builder 1798 will throw a warning and exit with 255. If the test died, even after 1799 having successfully completed all its tests, it will still be 1800 considered a failure and will exit with 255. 1801 1802 So the exit codes are... 1803 1804 0 all tests successful 1805 255 test died or all passed but wrong # of tests run 1806 any other number how many failed (including missing or extras) 1807 1808 If you fail more than 254 tests, it will be reported as 254. 1809 1810 1811 =head1 THREADS 1812 1813 In perl 5.8.1 and later, Test::Builder is thread-safe. The test 1814 number is shared amongst all threads. This means if one thread sets 1815 the test number using current_test() they will all be effected. 1816 1817 While versions earlier than 5.8.1 had threads they contain too many 1818 bugs to support. 1819 1820 Test::Builder is only thread-aware if threads.pm is loaded I<before> 1821 Test::Builder. 1822 1823 =head1 EXAMPLES 1824 1825 CPAN can provide the best examples. Test::Simple, Test::More, 1826 Test::Exception and Test::Differences all use Test::Builder. 1827 1828 =head1 SEE ALSO 1829 1830 Test::Simple, Test::More, Test::Harness 1831 1832 =head1 AUTHORS 1833 1834 Original code by chromatic, maintained by Michael G Schwern 1835 E<lt>schwern@pobox.comE<gt> 1836 1837 =head1 COPYRIGHT 1838 1839 Copyright 2002, 2004 by chromatic E<lt>chromatic@wgz.orgE<gt> and 1840 Michael G Schwern E<lt>schwern@pobox.comE<gt>. 1841 1842 This program is free software; you can redistribute it and/or 1843 modify it under the same terms as Perl itself. 1844 1845 See F<http://www.perl.com/perl/misc/Artistic.html> 1846 1847 =cut 1848 1849 1;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
| Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |