1b39c5158Smillertpackage Test::More; 2b39c5158Smillert 3b39c5158Smillertuse 5.006; 4b39c5158Smillertuse strict; 5b39c5158Smillertuse warnings; 6b39c5158Smillert 7b39c5158Smillert#---- perlcritic exemptions. ----# 8b39c5158Smillert 9b39c5158Smillert# We use a lot of subroutine prototypes 10b39c5158Smillert## no critic (Subroutines::ProhibitSubroutinePrototypes) 11b39c5158Smillert 12b8851fccSafresh1# Can't use Carp because it might cause C<use_ok()> to accidentally succeed 13b39c5158Smillert# even though the module being used forgot to use Carp. Yes, this 14b39c5158Smillert# actually happened. 15b39c5158Smillertsub _carp { 16b39c5158Smillert my( $file, $line ) = ( caller(1) )[ 1, 2 ]; 17b39c5158Smillert return warn @_, " at $file line $line\n"; 18b39c5158Smillert} 19b39c5158Smillert 20*3d61058aSafresh1our $VERSION = '1.302199'; 21b39c5158Smillert 229f11ffb7Safresh1use Test::Builder::Module; 23b39c5158Smillertour @ISA = qw(Test::Builder::Module); 24b39c5158Smillertour @EXPORT = qw(ok use_ok require_ok 25b39c5158Smillert is isnt like unlike is_deeply 26b39c5158Smillert cmp_ok 27b39c5158Smillert skip todo todo_skip 28b39c5158Smillert pass fail 29b39c5158Smillert eq_array eq_hash eq_set 30b39c5158Smillert $TODO 31b39c5158Smillert plan 32b39c5158Smillert done_testing 33b39c5158Smillert can_ok isa_ok new_ok 34b39c5158Smillert diag note explain 35b39c5158Smillert subtest 36b39c5158Smillert BAIL_OUT 37b39c5158Smillert); 38b39c5158Smillert 39b39c5158Smillert=head1 NAME 40b39c5158Smillert 41b39c5158SmillertTest::More - yet another framework for writing test scripts 42b39c5158Smillert 43b39c5158Smillert=head1 SYNOPSIS 44b39c5158Smillert 45b39c5158Smillert use Test::More tests => 23; 46b39c5158Smillert # or 47b39c5158Smillert use Test::More skip_all => $reason; 48b39c5158Smillert # or 49b39c5158Smillert use Test::More; # see done_testing() 50b39c5158Smillert 51b39c5158Smillert require_ok( 'Some::Module' ); 52b39c5158Smillert 53b39c5158Smillert # Various ways to say "ok" 54b39c5158Smillert ok($got eq $expected, $test_name); 55b39c5158Smillert 56b39c5158Smillert is ($got, $expected, $test_name); 57b39c5158Smillert isnt($got, $expected, $test_name); 58b39c5158Smillert 59b39c5158Smillert # Rather than print STDERR "# here's what went wrong\n" 60b39c5158Smillert diag("here's what went wrong"); 61b39c5158Smillert 62b39c5158Smillert like ($got, qr/expected/, $test_name); 63b39c5158Smillert unlike($got, qr/expected/, $test_name); 64b39c5158Smillert 65b39c5158Smillert cmp_ok($got, '==', $expected, $test_name); 66b39c5158Smillert 67b39c5158Smillert is_deeply($got_complex_structure, $expected_complex_structure, $test_name); 68b39c5158Smillert 69b39c5158Smillert SKIP: { 70b39c5158Smillert skip $why, $how_many unless $have_some_feature; 71b39c5158Smillert 72b39c5158Smillert ok( foo(), $test_name ); 73b39c5158Smillert is( foo(42), 23, $test_name ); 74b39c5158Smillert }; 75b39c5158Smillert 76b39c5158Smillert TODO: { 77b39c5158Smillert local $TODO = $why; 78b39c5158Smillert 79b39c5158Smillert ok( foo(), $test_name ); 80b39c5158Smillert is( foo(42), 23, $test_name ); 81b39c5158Smillert }; 82b39c5158Smillert 83b39c5158Smillert can_ok($module, @methods); 84b39c5158Smillert isa_ok($object, $class); 85b39c5158Smillert 86b39c5158Smillert pass($test_name); 87b39c5158Smillert fail($test_name); 88b39c5158Smillert 89b39c5158Smillert BAIL_OUT($why); 90b39c5158Smillert 91b39c5158Smillert # UNIMPLEMENTED!!! 92b39c5158Smillert my @status = Test::More::status; 93b39c5158Smillert 94b39c5158Smillert 95b39c5158Smillert=head1 DESCRIPTION 96b39c5158Smillert 97b39c5158SmillertB<STOP!> If you're just getting started writing tests, have a look at 98b46d8ef2Safresh1L<Test2::Suite> first. 99b46d8ef2Safresh1 100b46d8ef2Safresh1This is a drop in replacement for Test::Simple which you can switch to once you 101b46d8ef2Safresh1get the hang of basic testing. 102b39c5158Smillert 103b39c5158SmillertThe purpose of this module is to provide a wide range of testing 104b39c5158Smillertutilities. Various ways to say "ok" with better diagnostics, 105b39c5158Smillertfacilities to skip tests, test future features and compare complicated 106b39c5158Smillertdata structures. While you can do almost anything with a simple 107b39c5158SmillertC<ok()> function, it doesn't provide good diagnostic output. 108b39c5158Smillert 109b39c5158Smillert 110b39c5158Smillert=head2 I love it when a plan comes together 111b39c5158Smillert 112b39c5158SmillertBefore anything else, you need a testing plan. This basically declares 113b39c5158Smillerthow many tests your script is going to run to protect against premature 114b39c5158Smillertfailure. 115b39c5158Smillert 116b39c5158SmillertThe preferred way to do this is to declare a plan when you C<use Test::More>. 117b39c5158Smillert 118b39c5158Smillert use Test::More tests => 23; 119b39c5158Smillert 120b39c5158SmillertThere are cases when you will not know beforehand how many tests your 121b39c5158Smillertscript is going to run. In this case, you can declare your tests at 122b39c5158Smillertthe end. 123b39c5158Smillert 124b39c5158Smillert use Test::More; 125b39c5158Smillert 126b39c5158Smillert ... run your tests ... 127b39c5158Smillert 128b39c5158Smillert done_testing( $number_of_tests_run ); 129b39c5158Smillert 1309f11ffb7Safresh1B<NOTE> C<done_testing()> should never be called in an C<END { ... }> block. 1319f11ffb7Safresh1 132b39c5158SmillertSometimes you really don't know how many tests were run, or it's too 133b39c5158Smillertdifficult to calculate. In which case you can leave off 134b39c5158Smillert$number_of_tests_run. 135b39c5158Smillert 136b39c5158SmillertIn some cases, you'll want to completely skip an entire testing script. 137b39c5158Smillert 138b39c5158Smillert use Test::More skip_all => $skip_reason; 139b39c5158Smillert 140b39c5158SmillertYour script will declare a skip with the reason why you skipped and 141b39c5158Smillertexit immediately with a zero (success). See L<Test::Harness> for 142b39c5158Smillertdetails. 143b39c5158Smillert 144b39c5158SmillertIf you want to control what functions Test::More will export, you 145b39c5158Smillerthave to use the 'import' option. For example, to import everything 146b39c5158Smillertbut 'fail', you'd do: 147b39c5158Smillert 148b39c5158Smillert use Test::More tests => 23, import => ['!fail']; 149b39c5158Smillert 150b8851fccSafresh1Alternatively, you can use the C<plan()> function. Useful for when you 151b39c5158Smillerthave to calculate the number of tests. 152b39c5158Smillert 153b39c5158Smillert use Test::More; 154b39c5158Smillert plan tests => keys %Stuff * 3; 155b39c5158Smillert 156b39c5158Smillertor for deciding between running the tests at all: 157b39c5158Smillert 158b39c5158Smillert use Test::More; 159b39c5158Smillert if( $^O eq 'MacOS' ) { 160b39c5158Smillert plan skip_all => 'Test irrelevant on MacOS'; 161b39c5158Smillert } 162b39c5158Smillert else { 163b39c5158Smillert plan tests => 42; 164b39c5158Smillert } 165b39c5158Smillert 166b39c5158Smillert=cut 167b39c5158Smillert 168b39c5158Smillertsub plan { 169b39c5158Smillert my $tb = Test::More->builder; 170b39c5158Smillert 171b39c5158Smillert return $tb->plan(@_); 172b39c5158Smillert} 173b39c5158Smillert 174b39c5158Smillert# This implements "use Test::More 'no_diag'" but the behavior is 175b39c5158Smillert# deprecated. 176b39c5158Smillertsub import_extra { 177b39c5158Smillert my $class = shift; 178b39c5158Smillert my $list = shift; 179b39c5158Smillert 180b39c5158Smillert my @other = (); 181b39c5158Smillert my $idx = 0; 1829f11ffb7Safresh1 my $import; 183b39c5158Smillert while( $idx <= $#{$list} ) { 184b39c5158Smillert my $item = $list->[$idx]; 185b39c5158Smillert 186b39c5158Smillert if( defined $item and $item eq 'no_diag' ) { 187b39c5158Smillert $class->builder->no_diag(1); 188b39c5158Smillert } 1899f11ffb7Safresh1 elsif( defined $item and $item eq 'import' ) { 1909f11ffb7Safresh1 if ($import) { 1919f11ffb7Safresh1 push @$import, @{$list->[ ++$idx ]}; 1929f11ffb7Safresh1 } 1939f11ffb7Safresh1 else { 1949f11ffb7Safresh1 $import = $list->[ ++$idx ]; 1959f11ffb7Safresh1 push @other, $item, $import; 1969f11ffb7Safresh1 } 1979f11ffb7Safresh1 } 198b39c5158Smillert else { 199b39c5158Smillert push @other, $item; 200b39c5158Smillert } 201b39c5158Smillert 202b39c5158Smillert $idx++; 203b39c5158Smillert } 204b39c5158Smillert 205b39c5158Smillert @$list = @other; 206b39c5158Smillert 2079f11ffb7Safresh1 if ($class eq __PACKAGE__ && (!$import || grep $_ eq '$TODO', @$import)) { 2089f11ffb7Safresh1 my $to = $class->builder->exported_to; 2099f11ffb7Safresh1 no strict 'refs'; 2109f11ffb7Safresh1 *{"$to\::TODO"} = \our $TODO; 2119f11ffb7Safresh1 if ($import) { 2129f11ffb7Safresh1 @$import = grep $_ ne '$TODO', @$import; 2139f11ffb7Safresh1 } 2149f11ffb7Safresh1 else { 2159f11ffb7Safresh1 push @$list, import => [grep $_ ne '$TODO', @EXPORT]; 2169f11ffb7Safresh1 } 2179f11ffb7Safresh1 } 2189f11ffb7Safresh1 219b39c5158Smillert return; 220b39c5158Smillert} 221b39c5158Smillert 222b39c5158Smillert=over 4 223b39c5158Smillert 224b39c5158Smillert=item B<done_testing> 225b39c5158Smillert 226b39c5158Smillert done_testing(); 227b39c5158Smillert done_testing($number_of_tests); 228b39c5158Smillert 229b39c5158SmillertIf you don't know how many tests you're going to run, you can issue 230b39c5158Smillertthe plan when you're done running tests. 231b39c5158Smillert 232b8851fccSafresh1$number_of_tests is the same as C<plan()>, it's the number of tests you 233b39c5158Smillertexpected to run. You can omit this, in which case the number of tests 234b39c5158Smillertyou ran doesn't matter, just the fact that your tests ran to 235b39c5158Smillertconclusion. 236b39c5158Smillert 237b39c5158SmillertThis is safer than and replaces the "no_plan" plan. 238b39c5158Smillert 2399f11ffb7Safresh1B<Note:> You must never put C<done_testing()> inside an C<END { ... }> block. 2409f11ffb7Safresh1The plan is there to ensure your test does not exit before testing has 2419f11ffb7Safresh1completed. If you use an END block you completely bypass this protection. 2429f11ffb7Safresh1 243b39c5158Smillert=back 244b39c5158Smillert 245b39c5158Smillert=cut 246b39c5158Smillert 247b39c5158Smillertsub done_testing { 248b39c5158Smillert my $tb = Test::More->builder; 249b39c5158Smillert $tb->done_testing(@_); 250b39c5158Smillert} 251b39c5158Smillert 252b39c5158Smillert=head2 Test names 253b39c5158Smillert 254b39c5158SmillertBy convention, each test is assigned a number in order. This is 255b39c5158Smillertlargely done automatically for you. However, it's often very useful to 256b39c5158Smillertassign a name to each test. Which would you rather see: 257b39c5158Smillert 258b39c5158Smillert ok 4 259b39c5158Smillert not ok 5 260b39c5158Smillert ok 6 261b39c5158Smillert 262b39c5158Smillertor 263b39c5158Smillert 264b39c5158Smillert ok 4 - basic multi-variable 265b39c5158Smillert not ok 5 - simple exponential 266b39c5158Smillert ok 6 - force == mass * acceleration 267b39c5158Smillert 268b39c5158SmillertThe later gives you some idea of what failed. It also makes it easier 269b39c5158Smillertto find the test in your script, simply search for "simple 270b39c5158Smillertexponential". 271b39c5158Smillert 272b39c5158SmillertAll test functions take a name argument. It's optional, but highly 273b39c5158Smillertsuggested that you use it. 274b39c5158Smillert 275b39c5158Smillert=head2 I'm ok, you're not ok. 276b39c5158Smillert 277b39c5158SmillertThe basic purpose of this module is to print out either "ok #" or "not 278b39c5158Smillertok #" depending on if a given test succeeded or failed. Everything 279b39c5158Smillertelse is just gravy. 280b39c5158Smillert 281b39c5158SmillertAll of the following print "ok" or "not ok" depending on if the test 282b39c5158Smillertsucceeded or failed. They all also return true or false, 283b39c5158Smillertrespectively. 284b39c5158Smillert 285b39c5158Smillert=over 4 286b39c5158Smillert 287b39c5158Smillert=item B<ok> 288b39c5158Smillert 289b39c5158Smillert ok($got eq $expected, $test_name); 290b39c5158Smillert 291b39c5158SmillertThis simply evaluates any expression (C<$got eq $expected> is just a 292b39c5158Smillertsimple example) and uses that to determine if the test succeeded or 293b39c5158Smillertfailed. A true expression passes, a false one fails. Very simple. 294b39c5158Smillert 295b39c5158SmillertFor example: 296b39c5158Smillert 297b39c5158Smillert ok( $exp{9} == 81, 'simple exponential' ); 298b39c5158Smillert ok( Film->can('db_Main'), 'set_db()' ); 299b39c5158Smillert ok( $p->tests == 4, 'saw tests' ); 300e5157e49Safresh1 ok( !grep(!defined $_, @items), 'all items defined' ); 301b39c5158Smillert 302b39c5158Smillert(Mnemonic: "This is ok.") 303b39c5158Smillert 304b39c5158Smillert$test_name is a very short description of the test that will be printed 305b39c5158Smillertout. It makes it very easy to find a test in your script when it fails 306b39c5158Smillertand gives others an idea of your intentions. $test_name is optional, 307b39c5158Smillertbut we B<very> strongly encourage its use. 308b39c5158Smillert 309b8851fccSafresh1Should an C<ok()> fail, it will produce some diagnostics: 310b39c5158Smillert 311b39c5158Smillert not ok 18 - sufficient mucus 312b39c5158Smillert # Failed test 'sufficient mucus' 313b39c5158Smillert # in foo.t at line 42. 314b39c5158Smillert 315b8851fccSafresh1This is the same as L<Test::Simple>'s C<ok()> routine. 316b39c5158Smillert 317b39c5158Smillert=cut 318b39c5158Smillert 319b39c5158Smillertsub ok ($;$) { 320b39c5158Smillert my( $test, $name ) = @_; 321b39c5158Smillert my $tb = Test::More->builder; 322b39c5158Smillert 323b39c5158Smillert return $tb->ok( $test, $name ); 324b39c5158Smillert} 325b39c5158Smillert 326b39c5158Smillert=item B<is> 327b39c5158Smillert 328b39c5158Smillert=item B<isnt> 329b39c5158Smillert 330b39c5158Smillert is ( $got, $expected, $test_name ); 331b39c5158Smillert isnt( $got, $expected, $test_name ); 332b39c5158Smillert 333b8851fccSafresh1Similar to C<ok()>, C<is()> and C<isnt()> compare their two arguments 334b39c5158Smillertwith C<eq> and C<ne> respectively and use the result of that to 335b39c5158Smillertdetermine if the test succeeded or failed. So these: 336b39c5158Smillert 337b39c5158Smillert # Is the ultimate answer 42? 338b39c5158Smillert is( ultimate_answer(), 42, "Meaning of Life" ); 339b39c5158Smillert 340b39c5158Smillert # $foo isn't empty 341b39c5158Smillert isnt( $foo, '', "Got some foo" ); 342b39c5158Smillert 343b39c5158Smillertare similar to these: 344b39c5158Smillert 345b39c5158Smillert ok( ultimate_answer() eq 42, "Meaning of Life" ); 346b39c5158Smillert ok( $foo ne '', "Got some foo" ); 347b39c5158Smillert 3486eddea87SjasperC<undef> will only ever match C<undef>. So you can test a value 349e5157e49Safresh1against C<undef> like this: 3506eddea87Sjasper 3516eddea87Sjasper is($not_defined, undef, "undefined as expected"); 3526eddea87Sjasper 353b39c5158Smillert(Mnemonic: "This is that." "This isn't that.") 354b39c5158Smillert 355b8851fccSafresh1So why use these? They produce better diagnostics on failure. C<ok()> 356b8851fccSafresh1cannot know what you are testing for (beyond the name), but C<is()> and 357b8851fccSafresh1C<isnt()> know what the test was and why it failed. For example this 358b39c5158Smillerttest: 359b39c5158Smillert 360b39c5158Smillert my $foo = 'waffle'; my $bar = 'yarblokos'; 361b39c5158Smillert is( $foo, $bar, 'Is foo the same as bar?' ); 362b39c5158Smillert 363b39c5158SmillertWill produce something like this: 364b39c5158Smillert 365b39c5158Smillert not ok 17 - Is foo the same as bar? 366b39c5158Smillert # Failed test 'Is foo the same as bar?' 367b39c5158Smillert # in foo.t at line 139. 368b39c5158Smillert # got: 'waffle' 369b39c5158Smillert # expected: 'yarblokos' 370b39c5158Smillert 371b39c5158SmillertSo you can figure out what went wrong without rerunning the test. 372b39c5158Smillert 373b8851fccSafresh1You are encouraged to use C<is()> and C<isnt()> over C<ok()> where possible, 374b39c5158Smillerthowever do not be tempted to use them to find out if something is 375b39c5158Smillerttrue or false! 376b39c5158Smillert 377b39c5158Smillert # XXX BAD! 378b39c5158Smillert is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' ); 379b39c5158Smillert 380b39c5158SmillertThis does not check if C<exists $brooklyn{tree}> is true, it checks if 381b39c5158Smillertit returns 1. Very different. Similar caveats exist for false and 0. 382b8851fccSafresh1In these cases, use C<ok()>. 383b39c5158Smillert 384b39c5158Smillert ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' ); 385b39c5158Smillert 386b8851fccSafresh1A simple call to C<isnt()> usually does not provide a strong test but there 387b39c5158Smillertare cases when you cannot say much more about a value than that it is 388b39c5158Smillertdifferent from some other value: 389b39c5158Smillert 390b39c5158Smillert new_ok $obj, "Foo"; 391b39c5158Smillert 392b39c5158Smillert my $clone = $obj->clone; 393b39c5158Smillert isa_ok $obj, "Foo", "Foo->clone"; 394b39c5158Smillert 395b39c5158Smillert isnt $obj, $clone, "clone() produces a different object"; 396b39c5158Smillert 397e0680481Safresh1Historically we supported an C<isn't()> function as an alias of 398e0680481Safresh1C<isnt()>, however in Perl 5.37.9 support for the use of aprostrophe as 399e0680481Safresh1a package separator was deprecated and by Perl 5.42.0 support for it 400e0680481Safresh1will have been removed completely. Accordingly use of C<isn't()> is also 401e0680481Safresh1deprecated, and will produce warnings when used unless 'deprecated' 402e0680481Safresh1warnings are specifically disabled in the scope where it is used. You 403e0680481Safresh1are strongly advised to migrate to using C<isnt()> instead. 404b39c5158Smillert 405b39c5158Smillert=cut 406b39c5158Smillert 407b39c5158Smillertsub is ($$;$) { 408b39c5158Smillert my $tb = Test::More->builder; 409b39c5158Smillert 410b39c5158Smillert return $tb->is_eq(@_); 411b39c5158Smillert} 412b39c5158Smillert 413b39c5158Smillertsub isnt ($$;$) { 414b39c5158Smillert my $tb = Test::More->builder; 415b39c5158Smillert 416b39c5158Smillert return $tb->isnt_eq(@_); 417b39c5158Smillert} 418b39c5158Smillert 419e0680481Safresh1# Historically it was possible to use apostrophes as a package 420e0680481Safresh1# separator. make this available as isn't() for perl's that support it. 421e0680481Safresh1# However in 5.37.9 the apostrophe as a package separator was 422e0680481Safresh1# deprecated, so warn users of isn't() that they should use isnt() 423e0680481Safresh1# instead. We assume that if they are calling isn::t() they are doing so 424e0680481Safresh1# via isn't() as we have no way to be sure that they aren't spelling it 425e0680481Safresh1# with a double colon. We only trigger the warning if deprecation 426e0680481Safresh1# warnings are enabled, so the user can silence the warning if they 427e0680481Safresh1# wish. 428e0680481Safresh1sub isn::t { 429e0680481Safresh1 local ($@, $!, $?); 430e0680481Safresh1 if (warnings::enabled("deprecated")) { 431e0680481Safresh1 _carp 432e0680481Safresh1 "Use of apostrophe as package separator was deprecated in Perl 5.37.9,\n", 433e0680481Safresh1 "and will be removed in Perl 5.42.0. You should change code that uses\n", 434e0680481Safresh1 "Test::More::isn't() to use Test::More::isnt() as a replacement"; 435e0680481Safresh1 } 436e0680481Safresh1 goto &isnt; 437e0680481Safresh1} 438b39c5158Smillert 439b39c5158Smillert=item B<like> 440b39c5158Smillert 441b39c5158Smillert like( $got, qr/expected/, $test_name ); 442b39c5158Smillert 443b8851fccSafresh1Similar to C<ok()>, C<like()> matches $got against the regex C<qr/expected/>. 444b39c5158Smillert 445b39c5158SmillertSo this: 446b39c5158Smillert 447b39c5158Smillert like($got, qr/expected/, 'this is like that'); 448b39c5158Smillert 449b39c5158Smillertis similar to: 450b39c5158Smillert 451e5157e49Safresh1 ok( $got =~ m/expected/, 'this is like that'); 452b39c5158Smillert 453b39c5158Smillert(Mnemonic "This is like that".) 454b39c5158Smillert 455b39c5158SmillertThe second argument is a regular expression. It may be given as a 456b39c5158Smillertregex reference (i.e. C<qr//>) or (for better compatibility with older 457b39c5158Smillertperls) as a string that looks like a regex (alternative delimiters are 458b39c5158Smillertcurrently not supported): 459b39c5158Smillert 460b39c5158Smillert like( $got, '/expected/', 'this is like that' ); 461b39c5158Smillert 462b39c5158SmillertRegex options may be placed on the end (C<'/expected/i'>). 463b39c5158Smillert 464b8851fccSafresh1Its advantages over C<ok()> are similar to that of C<is()> and C<isnt()>. Better 465b39c5158Smillertdiagnostics on failure. 466b39c5158Smillert 467b39c5158Smillert=cut 468b39c5158Smillert 469b39c5158Smillertsub like ($$;$) { 470b39c5158Smillert my $tb = Test::More->builder; 471b39c5158Smillert 472b39c5158Smillert return $tb->like(@_); 473b39c5158Smillert} 474b39c5158Smillert 475b39c5158Smillert=item B<unlike> 476b39c5158Smillert 477b39c5158Smillert unlike( $got, qr/expected/, $test_name ); 478b39c5158Smillert 479b8851fccSafresh1Works exactly as C<like()>, only it checks if $got B<does not> match the 480b39c5158Smillertgiven pattern. 481b39c5158Smillert 482b39c5158Smillert=cut 483b39c5158Smillert 484b39c5158Smillertsub unlike ($$;$) { 485b39c5158Smillert my $tb = Test::More->builder; 486b39c5158Smillert 487b39c5158Smillert return $tb->unlike(@_); 488b39c5158Smillert} 489b39c5158Smillert 490b39c5158Smillert=item B<cmp_ok> 491b39c5158Smillert 492b39c5158Smillert cmp_ok( $got, $op, $expected, $test_name ); 493b39c5158Smillert 494e5157e49Safresh1Halfway between C<ok()> and C<is()> lies C<cmp_ok()>. This allows you 495e5157e49Safresh1to compare two arguments using any binary perl operator. The test 496e5157e49Safresh1passes if the comparison is true and fails otherwise. 497b39c5158Smillert 498b39c5158Smillert # ok( $got eq $expected ); 499b39c5158Smillert cmp_ok( $got, 'eq', $expected, 'this eq that' ); 500b39c5158Smillert 501b39c5158Smillert # ok( $got == $expected ); 502b39c5158Smillert cmp_ok( $got, '==', $expected, 'this == that' ); 503b39c5158Smillert 504b39c5158Smillert # ok( $got && $expected ); 505b39c5158Smillert cmp_ok( $got, '&&', $expected, 'this && that' ); 506b39c5158Smillert ...etc... 507b39c5158Smillert 508b8851fccSafresh1Its advantage over C<ok()> is when the test fails you'll know what $got 509b39c5158Smillertand $expected were: 510b39c5158Smillert 511b39c5158Smillert not ok 1 512b39c5158Smillert # Failed test in foo.t at line 12. 513b39c5158Smillert # '23' 514b39c5158Smillert # && 515b39c5158Smillert # undef 516b39c5158Smillert 517b39c5158SmillertIt's also useful in those cases where you are comparing numbers and 518b8851fccSafresh1C<is()>'s use of C<eq> will interfere: 519b39c5158Smillert 520b39c5158Smillert cmp_ok( $big_hairy_number, '==', $another_big_hairy_number ); 521b39c5158Smillert 522b39c5158SmillertIt's especially useful when comparing greater-than or smaller-than 523b39c5158Smillertrelation between values: 524b39c5158Smillert 525b39c5158Smillert cmp_ok( $some_value, '<=', $upper_limit ); 526b39c5158Smillert 527b39c5158Smillert 528b39c5158Smillert=cut 529b39c5158Smillert 530b39c5158Smillertsub cmp_ok($$$;$) { 531b39c5158Smillert my $tb = Test::More->builder; 532b39c5158Smillert 533b39c5158Smillert return $tb->cmp_ok(@_); 534b39c5158Smillert} 535b39c5158Smillert 536b39c5158Smillert=item B<can_ok> 537b39c5158Smillert 538b39c5158Smillert can_ok($module, @methods); 539b39c5158Smillert can_ok($object, @methods); 540b39c5158Smillert 541b39c5158SmillertChecks to make sure the $module or $object can do these @methods 542b39c5158Smillert(works with functions, too). 543b39c5158Smillert 544b39c5158Smillert can_ok('Foo', qw(this that whatever)); 545b39c5158Smillert 546b39c5158Smillertis almost exactly like saying: 547b39c5158Smillert 548b39c5158Smillert ok( Foo->can('this') && 549b39c5158Smillert Foo->can('that') && 550b39c5158Smillert Foo->can('whatever') 551b39c5158Smillert ); 552b39c5158Smillert 553b39c5158Smillertonly without all the typing and with a better interface. Handy for 554b39c5158Smillertquickly testing an interface. 555b39c5158Smillert 556b8851fccSafresh1No matter how many @methods you check, a single C<can_ok()> call counts 557b39c5158Smillertas one test. If you desire otherwise, use: 558b39c5158Smillert 559b39c5158Smillert foreach my $meth (@methods) { 560b39c5158Smillert can_ok('Foo', $meth); 561b39c5158Smillert } 562b39c5158Smillert 563b39c5158Smillert=cut 564b39c5158Smillert 565b39c5158Smillertsub can_ok ($@) { 566b39c5158Smillert my( $proto, @methods ) = @_; 567b39c5158Smillert my $class = ref $proto || $proto; 568b39c5158Smillert my $tb = Test::More->builder; 569b39c5158Smillert 570b39c5158Smillert unless($class) { 571b39c5158Smillert my $ok = $tb->ok( 0, "->can(...)" ); 572b39c5158Smillert $tb->diag(' can_ok() called with empty class or reference'); 573b39c5158Smillert return $ok; 574b39c5158Smillert } 575b39c5158Smillert 576b39c5158Smillert unless(@methods) { 577b39c5158Smillert my $ok = $tb->ok( 0, "$class->can(...)" ); 578b39c5158Smillert $tb->diag(' can_ok() called with no methods'); 579b39c5158Smillert return $ok; 580b39c5158Smillert } 581b39c5158Smillert 582b39c5158Smillert my @nok = (); 583b39c5158Smillert foreach my $method (@methods) { 584b39c5158Smillert $tb->_try( sub { $proto->can($method) } ) or push @nok, $method; 585b39c5158Smillert } 586b39c5158Smillert 587b39c5158Smillert my $name = (@methods == 1) ? "$class->can('$methods[0]')" : 588b39c5158Smillert "$class->can(...)" ; 589b39c5158Smillert 590b39c5158Smillert my $ok = $tb->ok( !@nok, $name ); 591b39c5158Smillert 592b39c5158Smillert $tb->diag( map " $class->can('$_') failed\n", @nok ); 593b39c5158Smillert 594b39c5158Smillert return $ok; 595b39c5158Smillert} 596b39c5158Smillert 597b39c5158Smillert=item B<isa_ok> 598b39c5158Smillert 599b39c5158Smillert isa_ok($object, $class, $object_name); 600b39c5158Smillert isa_ok($subclass, $class, $object_name); 601b39c5158Smillert isa_ok($ref, $type, $ref_name); 602b39c5158Smillert 603b39c5158SmillertChecks to see if the given C<< $object->isa($class) >>. Also checks to make 604b39c5158Smillertsure the object was defined in the first place. Handy for this sort 605b39c5158Smillertof thing: 606b39c5158Smillert 607b39c5158Smillert my $obj = Some::Module->new; 608b39c5158Smillert isa_ok( $obj, 'Some::Module' ); 609b39c5158Smillert 610b39c5158Smillertwhere you'd otherwise have to write 611b39c5158Smillert 612b39c5158Smillert my $obj = Some::Module->new; 613b39c5158Smillert ok( defined $obj && $obj->isa('Some::Module') ); 614b39c5158Smillert 615b39c5158Smillertto safeguard against your test script blowing up. 616b39c5158Smillert 617b39c5158SmillertYou can also test a class, to make sure that it has the right ancestor: 618b39c5158Smillert 619b39c5158Smillert isa_ok( 'Vole', 'Rodent' ); 620b39c5158Smillert 621b39c5158SmillertIt works on references, too: 622b39c5158Smillert 623b39c5158Smillert isa_ok( $array_ref, 'ARRAY' ); 624b39c5158Smillert 625b39c5158SmillertThe diagnostics of this test normally just refer to 'the object'. If 626b39c5158Smillertyou'd like them to be more specific, you can supply an $object_name 627b39c5158Smillert(for example 'Test customer'). 628b39c5158Smillert 629b39c5158Smillert=cut 630b39c5158Smillert 631b39c5158Smillertsub isa_ok ($$;$) { 632e5157e49Safresh1 my( $thing, $class, $thing_name ) = @_; 633b39c5158Smillert my $tb = Test::More->builder; 634b39c5158Smillert 635e5157e49Safresh1 my $whatami; 636e5157e49Safresh1 if( !defined $thing ) { 637e5157e49Safresh1 $whatami = 'undef'; 638e5157e49Safresh1 } 639e5157e49Safresh1 elsif( ref $thing ) { 640e5157e49Safresh1 $whatami = 'reference'; 641b39c5158Smillert 642e5157e49Safresh1 local($@,$!); 643e5157e49Safresh1 require Scalar::Util; 644e5157e49Safresh1 if( Scalar::Util::blessed($thing) ) { 645e5157e49Safresh1 $whatami = 'object'; 646e5157e49Safresh1 } 647b39c5158Smillert } 648b39c5158Smillert else { 649e5157e49Safresh1 $whatami = 'class'; 650e5157e49Safresh1 } 651e5157e49Safresh1 652b39c5158Smillert # We can't use UNIVERSAL::isa because we want to honor isa() overrides 653e5157e49Safresh1 my( $rslt, $error ) = $tb->_try( sub { $thing->isa($class) } ); 654e5157e49Safresh1 655b39c5158Smillert if($error) { 656e5157e49Safresh1 die <<WHOA unless $error =~ /^Can't (locate|call) method "isa"/; 657b39c5158SmillertWHOA! I tried to call ->isa on your $whatami and got some weird error. 658b39c5158SmillertHere's the error. 659b39c5158Smillert$error 660b39c5158SmillertWHOA 661b39c5158Smillert } 662e5157e49Safresh1 663e5157e49Safresh1 # Special case for isa_ok( [], "ARRAY" ) and like 664e5157e49Safresh1 if( $whatami eq 'reference' ) { 665e5157e49Safresh1 $rslt = UNIVERSAL::isa($thing, $class); 666b39c5158Smillert } 667b39c5158Smillert 668e5157e49Safresh1 my($diag, $name); 669e5157e49Safresh1 if( defined $thing_name ) { 670e5157e49Safresh1 $name = "'$thing_name' isa '$class'"; 671e5157e49Safresh1 $diag = defined $thing ? "'$thing_name' isn't a '$class'" : "'$thing_name' isn't defined"; 672e5157e49Safresh1 } 673e5157e49Safresh1 elsif( $whatami eq 'object' ) { 674e5157e49Safresh1 my $my_class = ref $thing; 675e5157e49Safresh1 $thing_name = qq[An object of class '$my_class']; 676e5157e49Safresh1 $name = "$thing_name isa '$class'"; 677e5157e49Safresh1 $diag = "The object of class '$my_class' isn't a '$class'"; 678e5157e49Safresh1 } 679e5157e49Safresh1 elsif( $whatami eq 'reference' ) { 680e5157e49Safresh1 my $type = ref $thing; 681e5157e49Safresh1 $thing_name = qq[A reference of type '$type']; 682e5157e49Safresh1 $name = "$thing_name isa '$class'"; 683e5157e49Safresh1 $diag = "The reference of type '$type' isn't a '$class'"; 684e5157e49Safresh1 } 685e5157e49Safresh1 elsif( $whatami eq 'undef' ) { 686e5157e49Safresh1 $thing_name = 'undef'; 687e5157e49Safresh1 $name = "$thing_name isa '$class'"; 688e5157e49Safresh1 $diag = "$thing_name isn't defined"; 689e5157e49Safresh1 } 690e5157e49Safresh1 elsif( $whatami eq 'class' ) { 691e5157e49Safresh1 $thing_name = qq[The class (or class-like) '$thing']; 692e5157e49Safresh1 $name = "$thing_name isa '$class'"; 693e5157e49Safresh1 $diag = "$thing_name isn't a '$class'"; 694b39c5158Smillert } 695b39c5158Smillert else { 696e5157e49Safresh1 die; 697e5157e49Safresh1 } 698e5157e49Safresh1 699e5157e49Safresh1 my $ok; 700e5157e49Safresh1 if($rslt) { 701b39c5158Smillert $ok = $tb->ok( 1, $name ); 702b39c5158Smillert } 703e5157e49Safresh1 else { 704e5157e49Safresh1 $ok = $tb->ok( 0, $name ); 705e5157e49Safresh1 $tb->diag(" $diag\n"); 706e5157e49Safresh1 } 707b39c5158Smillert 708b39c5158Smillert return $ok; 709b39c5158Smillert} 710b39c5158Smillert 711b39c5158Smillert=item B<new_ok> 712b39c5158Smillert 713b39c5158Smillert my $obj = new_ok( $class ); 714b39c5158Smillert my $obj = new_ok( $class => \@args ); 715b39c5158Smillert my $obj = new_ok( $class => \@args, $object_name ); 716b39c5158Smillert 717b39c5158SmillertA convenience function which combines creating an object and calling 718b8851fccSafresh1C<isa_ok()> on that object. 719b39c5158Smillert 720b39c5158SmillertIt is basically equivalent to: 721b39c5158Smillert 722b39c5158Smillert my $obj = $class->new(@args); 723b39c5158Smillert isa_ok $obj, $class, $object_name; 724b39c5158Smillert 725b39c5158SmillertIf @args is not given, an empty list will be used. 726b39c5158Smillert 727b8851fccSafresh1This function only works on C<new()> and it assumes C<new()> will return 728b39c5158Smillertjust a single object which isa C<$class>. 729b39c5158Smillert 730b39c5158Smillert=cut 731b39c5158Smillert 732b39c5158Smillertsub new_ok { 733b39c5158Smillert my $tb = Test::More->builder; 734b39c5158Smillert $tb->croak("new_ok() must be given at least a class") unless @_; 735b39c5158Smillert 736b39c5158Smillert my( $class, $args, $object_name ) = @_; 737b39c5158Smillert 738b39c5158Smillert $args ||= []; 739b39c5158Smillert 740b39c5158Smillert my $obj; 741b39c5158Smillert my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } ); 742b39c5158Smillert if($success) { 743b39c5158Smillert local $Test::Builder::Level = $Test::Builder::Level + 1; 744b39c5158Smillert isa_ok $obj, $class, $object_name; 745b39c5158Smillert } 746b39c5158Smillert else { 747e5157e49Safresh1 $class = 'undef' if !defined $class; 748e5157e49Safresh1 $tb->ok( 0, "$class->new() died" ); 749b39c5158Smillert $tb->diag(" Error was: $error"); 750b39c5158Smillert } 751b39c5158Smillert 752b39c5158Smillert return $obj; 753b39c5158Smillert} 754b39c5158Smillert 755b39c5158Smillert=item B<subtest> 756b39c5158Smillert 7579f11ffb7Safresh1 subtest $name => \&code, @args; 758b39c5158Smillert 759b8851fccSafresh1C<subtest()> runs the &code as its own little test with its own plan and 760b39c5158Smillertits own result. The main test counts this as a single test using the 761b39c5158Smillertresult of the whole subtest to determine if its ok or not ok. 762b39c5158Smillert 763b39c5158SmillertFor example... 764b39c5158Smillert 765b39c5158Smillert use Test::More tests => 3; 766b39c5158Smillert 767b39c5158Smillert pass("First test"); 768b39c5158Smillert 769b39c5158Smillert subtest 'An example subtest' => sub { 770b39c5158Smillert plan tests => 2; 771b39c5158Smillert 772b39c5158Smillert pass("This is a subtest"); 773b39c5158Smillert pass("So is this"); 774b39c5158Smillert }; 775b39c5158Smillert 776b39c5158Smillert pass("Third test"); 777b39c5158Smillert 778b39c5158SmillertThis would produce. 779b39c5158Smillert 780b39c5158Smillert 1..3 781b39c5158Smillert ok 1 - First test 782e5157e49Safresh1 # Subtest: An example subtest 783b39c5158Smillert 1..2 784b39c5158Smillert ok 1 - This is a subtest 785b39c5158Smillert ok 2 - So is this 786b39c5158Smillert ok 2 - An example subtest 787b39c5158Smillert ok 3 - Third test 788b39c5158Smillert 789b8851fccSafresh1A subtest may call C<skip_all>. No tests will be run, but the subtest is 790b39c5158Smillertconsidered a skip. 791b39c5158Smillert 792b39c5158Smillert subtest 'skippy' => sub { 793b39c5158Smillert plan skip_all => 'cuz I said so'; 794b39c5158Smillert pass('this test will never be run'); 795b39c5158Smillert }; 796b39c5158Smillert 797b39c5158SmillertReturns true if the subtest passed, false otherwise. 798b39c5158Smillert 79965d9bffcSjasperDue to how subtests work, you may omit a plan if you desire. This adds an 80065d9bffcSjasperimplicit C<done_testing()> to the end of your subtest. The following two 80165d9bffcSjaspersubtests are equivalent: 80265d9bffcSjasper 80365d9bffcSjasper subtest 'subtest with implicit done_testing()', sub { 80465d9bffcSjasper ok 1, 'subtests with an implicit done testing should work'; 80565d9bffcSjasper ok 1, '... and support more than one test'; 80665d9bffcSjasper ok 1, '... no matter how many tests are run'; 80765d9bffcSjasper }; 80865d9bffcSjasper 80965d9bffcSjasper subtest 'subtest with explicit done_testing()', sub { 81065d9bffcSjasper ok 1, 'subtests with an explicit done testing should work'; 81165d9bffcSjasper ok 1, '... and support more than one test'; 81265d9bffcSjasper ok 1, '... no matter how many tests are run'; 81365d9bffcSjasper done_testing(); 81465d9bffcSjasper }; 81565d9bffcSjasper 8169f11ffb7Safresh1Extra arguments given to C<subtest> are passed to the callback. For example: 8179f11ffb7Safresh1 8189f11ffb7Safresh1 sub my_subtest { 8199f11ffb7Safresh1 my $range = shift; 8209f11ffb7Safresh1 ... 8219f11ffb7Safresh1 } 8229f11ffb7Safresh1 8239f11ffb7Safresh1 for my $range (1, 10, 100, 1000) { 8249f11ffb7Safresh1 subtest "testing range $range", \&my_subtest, $range; 8259f11ffb7Safresh1 } 8269f11ffb7Safresh1 827b39c5158Smillert=cut 828b39c5158Smillert 8296eddea87Sjaspersub subtest { 830b39c5158Smillert my $tb = Test::More->builder; 831b39c5158Smillert return $tb->subtest(@_); 832b39c5158Smillert} 833b39c5158Smillert 834b39c5158Smillert=item B<pass> 835b39c5158Smillert 836b39c5158Smillert=item B<fail> 837b39c5158Smillert 838b39c5158Smillert pass($test_name); 839b39c5158Smillert fail($test_name); 840b39c5158Smillert 841b39c5158SmillertSometimes you just want to say that the tests have passed. Usually 842b39c5158Smillertthe case is you've got some complicated condition that is difficult to 843b8851fccSafresh1wedge into an C<ok()>. In this case, you can simply use C<pass()> (to 844b39c5158Smillertdeclare the test ok) or fail (for not ok). They are synonyms for 845b8851fccSafresh1C<ok(1)> and C<ok(0)>. 846b39c5158Smillert 847b39c5158SmillertUse these very, very, very sparingly. 848b39c5158Smillert 849b39c5158Smillert=cut 850b39c5158Smillert 851b39c5158Smillertsub pass (;$) { 852b39c5158Smillert my $tb = Test::More->builder; 853b39c5158Smillert 854b39c5158Smillert return $tb->ok( 1, @_ ); 855b39c5158Smillert} 856b39c5158Smillert 857b39c5158Smillertsub fail (;$) { 858b39c5158Smillert my $tb = Test::More->builder; 859b39c5158Smillert 860b39c5158Smillert return $tb->ok( 0, @_ ); 861b39c5158Smillert} 862b39c5158Smillert 863b39c5158Smillert=back 864b39c5158Smillert 865b39c5158Smillert 866b39c5158Smillert=head2 Module tests 867b39c5158Smillert 868e5157e49Safresh1Sometimes you want to test if a module, or a list of modules, can 869e5157e49Safresh1successfully load. For example, you'll often want a first test which 870e5157e49Safresh1simply loads all the modules in the distribution to make sure they 871e5157e49Safresh1work before going on to do more complicated testing. 872e5157e49Safresh1 873e5157e49Safresh1For such purposes we have C<use_ok> and C<require_ok>. 874b39c5158Smillert 875b39c5158Smillert=over 4 876b39c5158Smillert 877b39c5158Smillert=item B<require_ok> 878b39c5158Smillert 879b39c5158Smillert require_ok($module); 880b39c5158Smillert require_ok($file); 881b39c5158Smillert 882e5157e49Safresh1Tries to C<require> the given $module or $file. If it loads 883e5157e49Safresh1successfully, the test will pass. Otherwise it fails and displays the 884e5157e49Safresh1load error. 885e5157e49Safresh1 886e5157e49Safresh1C<require_ok> will guess whether the input is a module name or a 887e5157e49Safresh1filename. 888e5157e49Safresh1 889e5157e49Safresh1No exception will be thrown if the load fails. 890e5157e49Safresh1 891e5157e49Safresh1 # require Some::Module 892e5157e49Safresh1 require_ok "Some::Module"; 893e5157e49Safresh1 894e5157e49Safresh1 # require "Some/File.pl"; 895e5157e49Safresh1 require_ok "Some/File.pl"; 896e5157e49Safresh1 897e5157e49Safresh1 # stop testing if any of your modules will not load 898e5157e49Safresh1 for my $module (@module) { 899e5157e49Safresh1 require_ok $module or BAIL_OUT "Can't load $module"; 900e5157e49Safresh1 } 901b39c5158Smillert 902b39c5158Smillert=cut 903b39c5158Smillert 904b39c5158Smillertsub require_ok ($) { 905b39c5158Smillert my($module) = shift; 906b39c5158Smillert my $tb = Test::More->builder; 907b39c5158Smillert 908b39c5158Smillert my $pack = caller; 909b39c5158Smillert 91065d9bffcSjasper # Try to determine if we've been given a module name or file. 911b39c5158Smillert # Module names must be barewords, files not. 912b39c5158Smillert $module = qq['$module'] unless _is_module_name($module); 913b39c5158Smillert 914b39c5158Smillert my $code = <<REQUIRE; 915b39c5158Smillertpackage $pack; 916b39c5158Smillertrequire $module; 917b39c5158Smillert1; 918b39c5158SmillertREQUIRE 919b39c5158Smillert 920b39c5158Smillert my( $eval_result, $eval_error ) = _eval($code); 921b39c5158Smillert my $ok = $tb->ok( $eval_result, "require $module;" ); 922b39c5158Smillert 923b39c5158Smillert unless($ok) { 924b39c5158Smillert chomp $eval_error; 925b39c5158Smillert $tb->diag(<<DIAGNOSTIC); 926b39c5158Smillert Tried to require '$module'. 927b39c5158Smillert Error: $eval_error 928b39c5158SmillertDIAGNOSTIC 929b39c5158Smillert 930b39c5158Smillert } 931b39c5158Smillert 932b39c5158Smillert return $ok; 933b39c5158Smillert} 934b39c5158Smillert 935b39c5158Smillertsub _is_module_name { 936b39c5158Smillert my $module = shift; 937b39c5158Smillert 938b39c5158Smillert # Module names start with a letter. 939b39c5158Smillert # End with an alphanumeric. 940b39c5158Smillert # The rest is an alphanumeric or :: 941b39c5158Smillert $module =~ s/\b::\b//g; 942b39c5158Smillert 943b39c5158Smillert return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0; 944b39c5158Smillert} 945b39c5158Smillert 946e5157e49Safresh1 947e5157e49Safresh1=item B<use_ok> 948e5157e49Safresh1 949e5157e49Safresh1 BEGIN { use_ok($module); } 950e5157e49Safresh1 BEGIN { use_ok($module, @imports); } 951e5157e49Safresh1 952e5157e49Safresh1Like C<require_ok>, but it will C<use> the $module in question and 953e5157e49Safresh1only loads modules, not files. 954e5157e49Safresh1 955e5157e49Safresh1If you just want to test a module can be loaded, use C<require_ok>. 956e5157e49Safresh1 957e5157e49Safresh1If you just want to load a module in a test, we recommend simply using 958e5157e49Safresh1C<use> directly. It will cause the test to stop. 959e5157e49Safresh1 960b8851fccSafresh1It's recommended that you run C<use_ok()> inside a BEGIN block so its 961e5157e49Safresh1functions are exported at compile-time and prototypes are properly 962e5157e49Safresh1honored. 963e5157e49Safresh1 964e5157e49Safresh1If @imports are given, they are passed through to the use. So this: 965e5157e49Safresh1 966e5157e49Safresh1 BEGIN { use_ok('Some::Module', qw(foo bar)) } 967e5157e49Safresh1 968e5157e49Safresh1is like doing this: 969e5157e49Safresh1 970e5157e49Safresh1 use Some::Module qw(foo bar); 971e5157e49Safresh1 972e5157e49Safresh1Version numbers can be checked like so: 973e5157e49Safresh1 974e5157e49Safresh1 # Just like "use Some::Module 1.02" 975e5157e49Safresh1 BEGIN { use_ok('Some::Module', 1.02) } 976e5157e49Safresh1 977e5157e49Safresh1Don't try to do this: 978e5157e49Safresh1 979e5157e49Safresh1 BEGIN { 980e5157e49Safresh1 use_ok('Some::Module'); 981e5157e49Safresh1 982e5157e49Safresh1 ...some code that depends on the use... 983e5157e49Safresh1 ...happening at compile time... 984e5157e49Safresh1 } 985e5157e49Safresh1 986e5157e49Safresh1because the notion of "compile-time" is relative. Instead, you want: 987e5157e49Safresh1 988e5157e49Safresh1 BEGIN { use_ok('Some::Module') } 989e5157e49Safresh1 BEGIN { ...some code that depends on the use... } 990e5157e49Safresh1 991e5157e49Safresh1If you want the equivalent of C<use Foo ()>, use a module but not 992e5157e49Safresh1import anything, use C<require_ok>. 993e5157e49Safresh1 994e5157e49Safresh1 BEGIN { require_ok "Foo" } 995e5157e49Safresh1 996e5157e49Safresh1=cut 997e5157e49Safresh1 998e5157e49Safresh1sub use_ok ($;@) { 999e5157e49Safresh1 my( $module, @imports ) = @_; 1000e5157e49Safresh1 @imports = () unless @imports; 1001e5157e49Safresh1 my $tb = Test::More->builder; 1002e5157e49Safresh1 10039f11ffb7Safresh1 my %caller; 10049f11ffb7Safresh1 @caller{qw/pack file line sub args want eval req strict warn/} = caller(0); 10059f11ffb7Safresh1 10069f11ffb7Safresh1 my ($pack, $filename, $line, $warn) = @caller{qw/pack file line warn/}; 1007e5157e49Safresh1 $filename =~ y/\n\r/_/; # so it doesn't run off the "#line $line $f" line 1008e5157e49Safresh1 1009e5157e49Safresh1 my $code; 1010e5157e49Safresh1 if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) { 1011e5157e49Safresh1 # probably a version check. Perl needs to see the bare number 1012e5157e49Safresh1 # for it to work with non-Exporter based modules. 1013e5157e49Safresh1 $code = <<USE; 1014e5157e49Safresh1package $pack; 10159f11ffb7Safresh1BEGIN { \${^WARNING_BITS} = \$args[-1] if defined \$args[-1] } 1016e5157e49Safresh1#line $line $filename 1017e5157e49Safresh1use $module $imports[0]; 1018e5157e49Safresh11; 1019e5157e49Safresh1USE 1020e5157e49Safresh1 } 1021e5157e49Safresh1 else { 1022e5157e49Safresh1 $code = <<USE; 1023e5157e49Safresh1package $pack; 10249f11ffb7Safresh1BEGIN { \${^WARNING_BITS} = \$args[-1] if defined \$args[-1] } 1025e5157e49Safresh1#line $line $filename 1026e5157e49Safresh1use $module \@{\$args[0]}; 1027e5157e49Safresh11; 1028e5157e49Safresh1USE 1029e5157e49Safresh1 } 1030e5157e49Safresh1 10319f11ffb7Safresh1 my ($eval_result, $eval_error) = _eval($code, \@imports, $warn); 1032e5157e49Safresh1 my $ok = $tb->ok( $eval_result, "use $module;" ); 1033e5157e49Safresh1 1034e5157e49Safresh1 unless($ok) { 1035e5157e49Safresh1 chomp $eval_error; 1036e5157e49Safresh1 $@ =~ s{^BEGIN failed--compilation aborted at .*$} 1037e5157e49Safresh1 {BEGIN failed--compilation aborted at $filename line $line.}m; 1038e5157e49Safresh1 $tb->diag(<<DIAGNOSTIC); 1039e5157e49Safresh1 Tried to use '$module'. 1040e5157e49Safresh1 Error: $eval_error 1041e5157e49Safresh1DIAGNOSTIC 1042e5157e49Safresh1 1043e5157e49Safresh1 } 1044e5157e49Safresh1 1045e5157e49Safresh1 return $ok; 1046e5157e49Safresh1} 1047e5157e49Safresh1 1048e5157e49Safresh1sub _eval { 1049e5157e49Safresh1 my( $code, @args ) = @_; 1050e5157e49Safresh1 1051e5157e49Safresh1 # Work around oddities surrounding resetting of $@ by immediately 1052e5157e49Safresh1 # storing it. 1053e5157e49Safresh1 my( $sigdie, $eval_result, $eval_error ); 1054e5157e49Safresh1 { 1055e5157e49Safresh1 local( $@, $!, $SIG{__DIE__} ); # isolate eval 1056e5157e49Safresh1 $eval_result = eval $code; ## no critic (BuiltinFunctions::ProhibitStringyEval) 1057e5157e49Safresh1 $eval_error = $@; 1058e5157e49Safresh1 $sigdie = $SIG{__DIE__} || undef; 1059e5157e49Safresh1 } 1060e5157e49Safresh1 # make sure that $code got a chance to set $SIG{__DIE__} 1061e5157e49Safresh1 $SIG{__DIE__} = $sigdie if defined $sigdie; 1062e5157e49Safresh1 1063e5157e49Safresh1 return( $eval_result, $eval_error ); 1064e5157e49Safresh1} 1065e5157e49Safresh1 1066e5157e49Safresh1 1067b39c5158Smillert=back 1068b39c5158Smillert 1069b39c5158Smillert 1070b39c5158Smillert=head2 Complex data structures 1071b39c5158Smillert 1072b39c5158SmillertNot everything is a simple eq check or regex. There are times you 1073b39c5158Smillertneed to see if two data structures are equivalent. For these 1074b39c5158Smillertinstances Test::More provides a handful of useful functions. 1075b39c5158Smillert 1076b39c5158SmillertB<NOTE> I'm not quite sure what will happen with filehandles. 1077b39c5158Smillert 1078b39c5158Smillert=over 4 1079b39c5158Smillert 1080b39c5158Smillert=item B<is_deeply> 1081b39c5158Smillert 1082b39c5158Smillert is_deeply( $got, $expected, $test_name ); 1083b39c5158Smillert 1084b8851fccSafresh1Similar to C<is()>, except that if $got and $expected are references, it 1085b39c5158Smillertdoes a deep comparison walking each data structure to see if they are 1086b39c5158Smillertequivalent. If the two structures are different, it will display the 1087b39c5158Smillertplace where they start differing. 1088b39c5158Smillert 1089b8851fccSafresh1C<is_deeply()> compares the dereferenced values of references, the 1090b39c5158Smillertreferences themselves (except for their type) are ignored. This means 1091b39c5158Smillertaspects such as blessing and ties are not considered "different". 1092b39c5158Smillert 1093b8851fccSafresh1C<is_deeply()> currently has very limited handling of function reference 1094b39c5158Smillertand globs. It merely checks if they have the same referent. This may 1095b39c5158Smillertimprove in the future. 1096b39c5158Smillert 1097b39c5158SmillertL<Test::Differences> and L<Test::Deep> provide more in-depth functionality 1098b39c5158Smillertalong these lines. 1099b39c5158Smillert 11009f11ffb7Safresh1B<NOTE> is_deeply() has limitations when it comes to comparing strings and 11019f11ffb7Safresh1refs: 11029f11ffb7Safresh1 11039f11ffb7Safresh1 my $path = path('.'); 11049f11ffb7Safresh1 my $hash = {}; 11059f11ffb7Safresh1 is_deeply( $path, "$path" ); # ok 11069f11ffb7Safresh1 is_deeply( $hash, "$hash" ); # fail 11079f11ffb7Safresh1 11089f11ffb7Safresh1This happens because is_deeply will unoverload all arguments unconditionally. 11099f11ffb7Safresh1It is probably best not to use is_deeply with overloading. For legacy reasons 11109f11ffb7Safresh1this is not likely to ever be fixed. If you would like a much better tool for 11119f11ffb7Safresh1this you should see L<Test2::Suite> Specifically L<Test2::Tools::Compare> has 11129f11ffb7Safresh1an C<is()> function that works like C<is_deeply> with many improvements. 11139f11ffb7Safresh1 1114b39c5158Smillert=cut 1115b39c5158Smillert 1116b39c5158Smillertour( @Data_Stack, %Refs_Seen ); 1117b39c5158Smillertmy $DNE = bless [], 'Does::Not::Exist'; 1118b39c5158Smillert 1119b39c5158Smillertsub _dne { 1120b39c5158Smillert return ref $_[0] eq ref $DNE; 1121b39c5158Smillert} 1122b39c5158Smillert 1123b39c5158Smillert## no critic (Subroutines::RequireArgUnpacking) 1124b39c5158Smillertsub is_deeply { 1125b39c5158Smillert my $tb = Test::More->builder; 1126b39c5158Smillert 1127b39c5158Smillert unless( @_ == 2 or @_ == 3 ) { 1128b39c5158Smillert my $msg = <<'WARNING'; 1129b39c5158Smillertis_deeply() takes two or three args, you gave %d. 1130b39c5158SmillertThis usually means you passed an array or hash instead 1131b39c5158Smillertof a reference to it 1132b39c5158SmillertWARNING 1133b39c5158Smillert chop $msg; # clip off newline so carp() will put in line/file 1134b39c5158Smillert 1135b39c5158Smillert _carp sprintf $msg, scalar @_; 1136b39c5158Smillert 1137b39c5158Smillert return $tb->ok(0); 1138b39c5158Smillert } 1139b39c5158Smillert 1140b39c5158Smillert my( $got, $expected, $name ) = @_; 1141b39c5158Smillert 1142b39c5158Smillert $tb->_unoverload_str( \$expected, \$got ); 1143b39c5158Smillert 1144b39c5158Smillert my $ok; 1145b39c5158Smillert if( !ref $got and !ref $expected ) { # neither is a reference 1146b39c5158Smillert $ok = $tb->is_eq( $got, $expected, $name ); 1147b39c5158Smillert } 1148b39c5158Smillert elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't 1149b39c5158Smillert $ok = $tb->ok( 0, $name ); 1150b39c5158Smillert $tb->diag( _format_stack({ vals => [ $got, $expected ] }) ); 1151b39c5158Smillert } 1152b39c5158Smillert else { # both references 1153b39c5158Smillert local @Data_Stack = (); 1154b39c5158Smillert if( _deep_check( $got, $expected ) ) { 1155b39c5158Smillert $ok = $tb->ok( 1, $name ); 1156b39c5158Smillert } 1157b39c5158Smillert else { 1158b39c5158Smillert $ok = $tb->ok( 0, $name ); 1159b39c5158Smillert $tb->diag( _format_stack(@Data_Stack) ); 1160b39c5158Smillert } 1161b39c5158Smillert } 1162b39c5158Smillert 1163b39c5158Smillert return $ok; 1164b39c5158Smillert} 1165b39c5158Smillert 1166b39c5158Smillertsub _format_stack { 1167b39c5158Smillert my(@Stack) = @_; 1168b39c5158Smillert 1169b39c5158Smillert my $var = '$FOO'; 1170b39c5158Smillert my $did_arrow = 0; 1171b39c5158Smillert foreach my $entry (@Stack) { 1172b39c5158Smillert my $type = $entry->{type} || ''; 1173b39c5158Smillert my $idx = $entry->{'idx'}; 1174b39c5158Smillert if( $type eq 'HASH' ) { 1175b39c5158Smillert $var .= "->" unless $did_arrow++; 1176b39c5158Smillert $var .= "{$idx}"; 1177b39c5158Smillert } 1178b39c5158Smillert elsif( $type eq 'ARRAY' ) { 1179b39c5158Smillert $var .= "->" unless $did_arrow++; 1180b39c5158Smillert $var .= "[$idx]"; 1181b39c5158Smillert } 1182b39c5158Smillert elsif( $type eq 'REF' ) { 1183b39c5158Smillert $var = "\${$var}"; 1184b39c5158Smillert } 1185b39c5158Smillert } 1186b39c5158Smillert 1187b39c5158Smillert my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ]; 1188b39c5158Smillert my @vars = (); 1189b39c5158Smillert ( $vars[0] = $var ) =~ s/\$FOO/ \$got/; 1190b39c5158Smillert ( $vars[1] = $var ) =~ s/\$FOO/\$expected/; 1191b39c5158Smillert 1192b39c5158Smillert my $out = "Structures begin differing at:\n"; 1193b39c5158Smillert foreach my $idx ( 0 .. $#vals ) { 1194b39c5158Smillert my $val = $vals[$idx]; 1195b39c5158Smillert $vals[$idx] 1196b39c5158Smillert = !defined $val ? 'undef' 1197b39c5158Smillert : _dne($val) ? "Does not exist" 1198b39c5158Smillert : ref $val ? "$val" 1199b39c5158Smillert : "'$val'"; 1200b39c5158Smillert } 1201b39c5158Smillert 1202b39c5158Smillert $out .= "$vars[0] = $vals[0]\n"; 1203b39c5158Smillert $out .= "$vars[1] = $vals[1]\n"; 1204b39c5158Smillert 1205b39c5158Smillert $out =~ s/^/ /msg; 1206b39c5158Smillert return $out; 1207b39c5158Smillert} 1208b39c5158Smillert 1209*3d61058aSafresh1my %_types = ( 1210*3d61058aSafresh1 (map +($_ => $_), qw( 1211*3d61058aSafresh1 Regexp 1212*3d61058aSafresh1 ARRAY 1213*3d61058aSafresh1 HASH 1214*3d61058aSafresh1 SCALAR 1215*3d61058aSafresh1 REF 1216*3d61058aSafresh1 GLOB 1217*3d61058aSafresh1 CODE 1218*3d61058aSafresh1 )), 1219*3d61058aSafresh1 'LVALUE' => 'SCALAR', 1220*3d61058aSafresh1 'REF' => 'SCALAR', 1221*3d61058aSafresh1 'VSTRING' => 'SCALAR', 1222*3d61058aSafresh1); 1223*3d61058aSafresh1 1224b39c5158Smillertsub _type { 1225b39c5158Smillert my $thing = shift; 1226b39c5158Smillert 1227b39c5158Smillert return '' if !ref $thing; 1228b39c5158Smillert 1229*3d61058aSafresh1 for my $type (keys %_types) { 1230*3d61058aSafresh1 return $_types{$type} if UNIVERSAL::isa( $thing, $type ); 1231b39c5158Smillert } 1232b39c5158Smillert 1233b39c5158Smillert return ''; 1234b39c5158Smillert} 1235b39c5158Smillert 1236b39c5158Smillert=back 1237b39c5158Smillert 1238b39c5158Smillert 1239b39c5158Smillert=head2 Diagnostics 1240b39c5158Smillert 1241b39c5158SmillertIf you pick the right test function, you'll usually get a good idea of 1242b39c5158Smillertwhat went wrong when it failed. But sometimes it doesn't work out 1243b39c5158Smillertthat way. So here we have ways for you to write your own diagnostic 1244b39c5158Smillertmessages which are safer than just C<print STDERR>. 1245b39c5158Smillert 1246b39c5158Smillert=over 4 1247b39c5158Smillert 1248b39c5158Smillert=item B<diag> 1249b39c5158Smillert 1250b39c5158Smillert diag(@diagnostic_message); 1251b39c5158Smillert 1252b39c5158SmillertPrints a diagnostic message which is guaranteed not to interfere with 1253b39c5158Smillerttest output. Like C<print> @diagnostic_message is simply concatenated 1254b39c5158Smillerttogether. 1255b39c5158Smillert 1256b39c5158SmillertReturns false, so as to preserve failure. 1257b39c5158Smillert 1258b39c5158SmillertHandy for this sort of thing: 1259b39c5158Smillert 1260b39c5158Smillert ok( grep(/foo/, @users), "There's a foo user" ) or 1261b39c5158Smillert diag("Since there's no foo, check that /etc/bar is set up right"); 1262b39c5158Smillert 1263b39c5158Smillertwhich would produce: 1264b39c5158Smillert 1265b39c5158Smillert not ok 42 - There's a foo user 1266b39c5158Smillert # Failed test 'There's a foo user' 1267b39c5158Smillert # in foo.t at line 52. 1268b39c5158Smillert # Since there's no foo, check that /etc/bar is set up right. 1269b39c5158Smillert 1270b39c5158SmillertYou might remember C<ok() or diag()> with the mnemonic C<open() or 1271b39c5158Smillertdie()>. 1272b39c5158Smillert 1273b39c5158SmillertB<NOTE> The exact formatting of the diagnostic output is still 1274e5157e49Safresh1changing, but it is guaranteed that whatever you throw at it won't 1275b39c5158Smillertinterfere with the test. 1276b39c5158Smillert 1277b39c5158Smillert=item B<note> 1278b39c5158Smillert 1279b39c5158Smillert note(@diagnostic_message); 1280b39c5158Smillert 1281b8851fccSafresh1Like C<diag()>, except the message will not be seen when the test is run 1282b39c5158Smillertin a harness. It will only be visible in the verbose TAP stream. 1283b39c5158Smillert 1284b39c5158SmillertHandy for putting in notes which might be useful for debugging, but 1285b39c5158Smillertdon't indicate a problem. 1286b39c5158Smillert 1287b39c5158Smillert note("Tempfile is $tempfile"); 1288b39c5158Smillert 1289b39c5158Smillert=cut 1290b39c5158Smillert 1291b39c5158Smillertsub diag { 1292b39c5158Smillert return Test::More->builder->diag(@_); 1293b39c5158Smillert} 1294b39c5158Smillert 1295b39c5158Smillertsub note { 1296b39c5158Smillert return Test::More->builder->note(@_); 1297b39c5158Smillert} 1298b39c5158Smillert 1299b39c5158Smillert=item B<explain> 1300b39c5158Smillert 1301b39c5158Smillert my @dump = explain @diagnostic_message; 1302b39c5158Smillert 1303b39c5158SmillertWill dump the contents of any references in a human readable format. 1304b39c5158SmillertUsually you want to pass this into C<note> or C<diag>. 1305b39c5158Smillert 1306b39c5158SmillertHandy for things like... 1307b39c5158Smillert 1308b39c5158Smillert is_deeply($have, $want) || diag explain $have; 1309b39c5158Smillert 1310b39c5158Smillertor 1311b39c5158Smillert 1312b39c5158Smillert note explain \%args; 1313b39c5158Smillert Some::Class->method(%args); 1314b39c5158Smillert 1315b39c5158Smillert=cut 1316b39c5158Smillert 1317b39c5158Smillertsub explain { 1318b39c5158Smillert return Test::More->builder->explain(@_); 1319b39c5158Smillert} 1320b39c5158Smillert 1321b39c5158Smillert=back 1322b39c5158Smillert 1323b39c5158Smillert 1324b39c5158Smillert=head2 Conditional tests 1325b39c5158Smillert 1326b39c5158SmillertSometimes running a test under certain conditions will cause the 1327b39c5158Smillerttest script to die. A certain function or method isn't implemented 1328b8851fccSafresh1(such as C<fork()> on MacOS), some resource isn't available (like a 1329b39c5158Smillertnet connection) or a module isn't available. In these cases it's 1330b39c5158Smillertnecessary to skip tests, or declare that they are supposed to fail 1331b39c5158Smillertbut will work in the future (a todo test). 1332b39c5158Smillert 1333b39c5158SmillertFor more details on the mechanics of skip and todo tests see 1334b39c5158SmillertL<Test::Harness>. 1335b39c5158Smillert 1336b39c5158SmillertThe way Test::More handles this is with a named block. Basically, a 1337b39c5158Smillertblock of tests which can be skipped over or made todo. It's best if I 1338b39c5158Smillertjust show you... 1339b39c5158Smillert 1340b39c5158Smillert=over 4 1341b39c5158Smillert 1342b39c5158Smillert=item B<SKIP: BLOCK> 1343b39c5158Smillert 1344b39c5158Smillert SKIP: { 1345b39c5158Smillert skip $why, $how_many if $condition; 1346b39c5158Smillert 1347b39c5158Smillert ...normal testing code goes here... 1348b39c5158Smillert } 1349b39c5158Smillert 1350b39c5158SmillertThis declares a block of tests that might be skipped, $how_many tests 1351b39c5158Smillertthere are, $why and under what $condition to skip them. An example is 1352b39c5158Smillertthe easiest way to illustrate: 1353b39c5158Smillert 1354b39c5158Smillert SKIP: { 1355b39c5158Smillert eval { require HTML::Lint }; 1356b39c5158Smillert 1357b39c5158Smillert skip "HTML::Lint not installed", 2 if $@; 1358b39c5158Smillert 1359b39c5158Smillert my $lint = new HTML::Lint; 1360b39c5158Smillert isa_ok( $lint, "HTML::Lint" ); 1361b39c5158Smillert 1362b39c5158Smillert $lint->parse( $html ); 1363b39c5158Smillert is( $lint->errors, 0, "No errors found in HTML" ); 1364b39c5158Smillert } 1365b39c5158Smillert 1366b39c5158SmillertIf the user does not have HTML::Lint installed, the whole block of 1367b39c5158Smillertcode I<won't be run at all>. Test::More will output special ok's 1368b39c5158Smillertwhich Test::Harness interprets as skipped, but passing, tests. 1369b39c5158Smillert 1370b39c5158SmillertIt's important that $how_many accurately reflects the number of tests 1371b39c5158Smillertin the SKIP block so the # of tests run will match up with your plan. 1372b39c5158SmillertIf your plan is C<no_plan> $how_many is optional and will default to 1. 1373b39c5158Smillert 1374b39c5158SmillertIt's perfectly safe to nest SKIP blocks. Each SKIP block must have 1375b39c5158Smillertthe label C<SKIP>, or Test::More can't work its magic. 1376b39c5158Smillert 1377b39c5158SmillertYou don't skip tests which are failing because there's a bug in your 1378b39c5158Smillertprogram, or for which you don't yet have code written. For that you 1379b39c5158Smillertuse TODO. Read on. 1380b39c5158Smillert 1381b39c5158Smillert=cut 1382b39c5158Smillert 1383b39c5158Smillert## no critic (Subroutines::RequireFinalReturn) 1384b39c5158Smillertsub skip { 1385b39c5158Smillert my( $why, $how_many ) = @_; 1386b39c5158Smillert my $tb = Test::More->builder; 1387b39c5158Smillert 13889f11ffb7Safresh1 # If the plan is set, and is static, then skip needs a count. If the plan 13899f11ffb7Safresh1 # is 'no_plan' we are fine. As well if plan is undefined then we are 13909f11ffb7Safresh1 # waiting for done_testing. 1391b39c5158Smillert unless (defined $how_many) { 13929f11ffb7Safresh1 my $plan = $tb->has_plan; 1393b39c5158Smillert _carp "skip() needs to know \$how_many tests are in the block" 13949f11ffb7Safresh1 if $plan && $plan =~ m/^\d+$/; 1395b39c5158Smillert $how_many = 1; 1396b39c5158Smillert } 1397b39c5158Smillert 1398b39c5158Smillert if( defined $how_many and $how_many =~ /\D/ ) { 1399b39c5158Smillert _carp 1400b39c5158Smillert "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?"; 1401b39c5158Smillert $how_many = 1; 1402b39c5158Smillert } 1403b39c5158Smillert 1404b39c5158Smillert for( 1 .. $how_many ) { 1405b39c5158Smillert $tb->skip($why); 1406b39c5158Smillert } 1407b39c5158Smillert 1408b39c5158Smillert no warnings 'exiting'; 1409b39c5158Smillert last SKIP; 1410b39c5158Smillert} 1411b39c5158Smillert 1412b39c5158Smillert=item B<TODO: BLOCK> 1413b39c5158Smillert 1414b39c5158Smillert TODO: { 1415b39c5158Smillert local $TODO = $why if $condition; 1416b39c5158Smillert 1417b39c5158Smillert ...normal testing code goes here... 1418b39c5158Smillert } 1419b39c5158Smillert 1420b39c5158SmillertDeclares a block of tests you expect to fail and $why. Perhaps it's 1421b39c5158Smillertbecause you haven't fixed a bug or haven't finished a new feature: 1422b39c5158Smillert 1423b39c5158Smillert TODO: { 1424b39c5158Smillert local $TODO = "URI::Geller not finished"; 1425b39c5158Smillert 1426b39c5158Smillert my $card = "Eight of clubs"; 1427b39c5158Smillert is( URI::Geller->your_card, $card, 'Is THIS your card?' ); 1428b39c5158Smillert 1429b39c5158Smillert my $spoon; 1430b39c5158Smillert URI::Geller->bend_spoon; 1431b39c5158Smillert is( $spoon, 'bent', "Spoon bending, that's original" ); 1432b39c5158Smillert } 1433b39c5158Smillert 1434b39c5158SmillertWith a todo block, the tests inside are expected to fail. Test::More 1435b39c5158Smillertwill run the tests normally, but print out special flags indicating 1436b8851fccSafresh1they are "todo". L<Test::Harness> will interpret failures as being ok. 1437b39c5158SmillertShould anything succeed, it will report it as an unexpected success. 1438b39c5158SmillertYou then know the thing you had todo is done and can remove the 1439b39c5158SmillertTODO flag. 1440b39c5158Smillert 1441b39c5158SmillertThe nice part about todo tests, as opposed to simply commenting out a 144256d68f1eSafresh1block of tests, is that it is like having a programmatic todo list. You know 1443b39c5158Smillerthow much work is left to be done, you're aware of what bugs there are, 1444b39c5158Smillertand you'll know immediately when they're fixed. 1445b39c5158Smillert 1446b39c5158SmillertOnce a todo test starts succeeding, simply move it outside the block. 1447b39c5158SmillertWhen the block is empty, delete it. 1448b39c5158Smillert 1449eac174f2Safresh1Note that, if you leave $TODO unset or undef, Test::More reports failures 1450eac174f2Safresh1as normal. This can be useful to mark the tests as expected to fail only 1451eac174f2Safresh1in certain conditions, e.g.: 1452eac174f2Safresh1 1453eac174f2Safresh1 TODO: { 1454eac174f2Safresh1 local $TODO = "$^O doesn't work yet. :(" if !_os_is_supported($^O); 1455eac174f2Safresh1 1456eac174f2Safresh1 ... 1457eac174f2Safresh1 } 1458b39c5158Smillert 1459b39c5158Smillert=item B<todo_skip> 1460b39c5158Smillert 1461b39c5158Smillert TODO: { 1462b39c5158Smillert todo_skip $why, $how_many if $condition; 1463b39c5158Smillert 1464b39c5158Smillert ...normal testing code... 1465b39c5158Smillert } 1466b39c5158Smillert 1467b39c5158SmillertWith todo tests, it's best to have the tests actually run. That way 1468b39c5158Smillertyou'll know when they start passing. Sometimes this isn't possible. 1469b39c5158SmillertOften a failing test will cause the whole program to die or hang, even 1470b39c5158Smillertinside an C<eval BLOCK> with and using C<alarm>. In these extreme 1471b39c5158Smillertcases you have no choice but to skip over the broken tests entirely. 1472b39c5158Smillert 1473b39c5158SmillertThe syntax and behavior is similar to a C<SKIP: BLOCK> except the 1474b8851fccSafresh1tests will be marked as failing but todo. L<Test::Harness> will 1475b39c5158Smillertinterpret them as passing. 1476b39c5158Smillert 1477b39c5158Smillert=cut 1478b39c5158Smillert 1479b39c5158Smillertsub todo_skip { 1480b39c5158Smillert my( $why, $how_many ) = @_; 1481b39c5158Smillert my $tb = Test::More->builder; 1482b39c5158Smillert 1483b39c5158Smillert unless( defined $how_many ) { 1484b39c5158Smillert # $how_many can only be avoided when no_plan is in use. 1485b39c5158Smillert _carp "todo_skip() needs to know \$how_many tests are in the block" 1486b39c5158Smillert unless $tb->has_plan eq 'no_plan'; 1487b39c5158Smillert $how_many = 1; 1488b39c5158Smillert } 1489b39c5158Smillert 1490b39c5158Smillert for( 1 .. $how_many ) { 1491b39c5158Smillert $tb->todo_skip($why); 1492b39c5158Smillert } 1493b39c5158Smillert 1494b39c5158Smillert no warnings 'exiting'; 1495b39c5158Smillert last TODO; 1496b39c5158Smillert} 1497b39c5158Smillert 1498b39c5158Smillert=item When do I use SKIP vs. TODO? 1499b39c5158Smillert 1500b39c5158SmillertB<If it's something the user might not be able to do>, use SKIP. 1501b39c5158SmillertThis includes optional modules that aren't installed, running under 1502b8851fccSafresh1an OS that doesn't have some feature (like C<fork()> or symlinks), or maybe 1503b39c5158Smillertyou need an Internet connection and one isn't available. 1504b39c5158Smillert 1505b39c5158SmillertB<If it's something the programmer hasn't done yet>, use TODO. This 1506b39c5158Smillertis for any code you haven't written yet, or bugs you have yet to fix, 1507b39c5158Smillertbut want to put tests in your testing script (always a good idea). 1508b39c5158Smillert 1509b39c5158Smillert 1510b39c5158Smillert=back 1511b39c5158Smillert 1512b39c5158Smillert 1513b39c5158Smillert=head2 Test control 1514b39c5158Smillert 1515b39c5158Smillert=over 4 1516b39c5158Smillert 1517b39c5158Smillert=item B<BAIL_OUT> 1518b39c5158Smillert 1519b39c5158Smillert BAIL_OUT($reason); 1520b39c5158Smillert 1521b39c5158SmillertIndicates to the harness that things are going so badly all testing 152265d9bffcSjaspershould terminate. This includes the running of any additional test scripts. 1523b39c5158Smillert 1524b39c5158SmillertThis is typically used when testing cannot continue such as a critical 1525b39c5158Smillertmodule failing to compile or a necessary external utility not being 1526b39c5158Smillertavailable such as a database connection failing. 1527b39c5158Smillert 1528b39c5158SmillertThe test will exit with 255. 1529b39c5158Smillert 1530b39c5158SmillertFor even better control look at L<Test::Most>. 1531b39c5158Smillert 1532b39c5158Smillert=cut 1533b39c5158Smillert 1534b39c5158Smillertsub BAIL_OUT { 1535b39c5158Smillert my $reason = shift; 1536b39c5158Smillert my $tb = Test::More->builder; 1537b39c5158Smillert 1538b39c5158Smillert $tb->BAIL_OUT($reason); 1539b39c5158Smillert} 1540b39c5158Smillert 1541b39c5158Smillert=back 1542b39c5158Smillert 1543b39c5158Smillert 1544b39c5158Smillert=head2 Discouraged comparison functions 1545b39c5158Smillert 1546b39c5158SmillertThe use of the following functions is discouraged as they are not 1547b39c5158Smillertactually testing functions and produce no diagnostics to help figure 1548b8851fccSafresh1out what went wrong. They were written before C<is_deeply()> existed 1549b39c5158Smillertbecause I couldn't figure out how to display a useful diff of two 1550b39c5158Smillertarbitrary data structures. 1551b39c5158Smillert 1552b8851fccSafresh1These functions are usually used inside an C<ok()>. 1553b39c5158Smillert 1554b39c5158Smillert ok( eq_array(\@got, \@expected) ); 1555b39c5158Smillert 1556b39c5158SmillertC<is_deeply()> can do that better and with diagnostics. 1557b39c5158Smillert 1558b39c5158Smillert is_deeply( \@got, \@expected ); 1559b39c5158Smillert 1560b39c5158SmillertThey may be deprecated in future versions. 1561b39c5158Smillert 1562b39c5158Smillert=over 4 1563b39c5158Smillert 1564b39c5158Smillert=item B<eq_array> 1565b39c5158Smillert 1566b39c5158Smillert my $is_eq = eq_array(\@got, \@expected); 1567b39c5158Smillert 1568b39c5158SmillertChecks if two arrays are equivalent. This is a deep check, so 1569b39c5158Smillertmulti-level structures are handled correctly. 1570b39c5158Smillert 1571b39c5158Smillert=cut 1572b39c5158Smillert 1573b39c5158Smillert#'# 1574b39c5158Smillertsub eq_array { 1575b39c5158Smillert local @Data_Stack = (); 1576b39c5158Smillert _deep_check(@_); 1577b39c5158Smillert} 1578b39c5158Smillert 1579b39c5158Smillertsub _eq_array { 1580b39c5158Smillert my( $a1, $a2 ) = @_; 1581b39c5158Smillert 1582b39c5158Smillert if( grep _type($_) ne 'ARRAY', $a1, $a2 ) { 1583b39c5158Smillert warn "eq_array passed a non-array ref"; 1584b39c5158Smillert return 0; 1585b39c5158Smillert } 1586b39c5158Smillert 1587b39c5158Smillert return 1 if $a1 eq $a2; 1588b39c5158Smillert 1589b39c5158Smillert my $ok = 1; 1590b39c5158Smillert my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2; 1591b39c5158Smillert for( 0 .. $max ) { 1592b39c5158Smillert my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_]; 1593b39c5158Smillert my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_]; 1594b39c5158Smillert 159565d9bffcSjasper next if _equal_nonrefs($e1, $e2); 159665d9bffcSjasper 1597b39c5158Smillert push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] }; 1598b39c5158Smillert $ok = _deep_check( $e1, $e2 ); 1599b39c5158Smillert pop @Data_Stack if $ok; 1600b39c5158Smillert 1601b39c5158Smillert last unless $ok; 1602b39c5158Smillert } 1603b39c5158Smillert 1604b39c5158Smillert return $ok; 1605b39c5158Smillert} 1606b39c5158Smillert 160765d9bffcSjaspersub _equal_nonrefs { 160865d9bffcSjasper my( $e1, $e2 ) = @_; 160965d9bffcSjasper 161065d9bffcSjasper return if ref $e1 or ref $e2; 161165d9bffcSjasper 161265d9bffcSjasper if ( defined $e1 ) { 161365d9bffcSjasper return 1 if defined $e2 and $e1 eq $e2; 161465d9bffcSjasper } 161565d9bffcSjasper else { 161665d9bffcSjasper return 1 if !defined $e2; 161765d9bffcSjasper } 161865d9bffcSjasper 161965d9bffcSjasper return; 162065d9bffcSjasper} 162165d9bffcSjasper 1622b39c5158Smillertsub _deep_check { 1623b39c5158Smillert my( $e1, $e2 ) = @_; 1624b39c5158Smillert my $tb = Test::More->builder; 1625b39c5158Smillert 1626b39c5158Smillert my $ok = 0; 1627b39c5158Smillert 1628b39c5158Smillert # Effectively turn %Refs_Seen into a stack. This avoids picking up 1629b39c5158Smillert # the same referenced used twice (such as [\$a, \$a]) to be considered 1630b39c5158Smillert # circular. 1631b39c5158Smillert local %Refs_Seen = %Refs_Seen; 1632b39c5158Smillert 1633b39c5158Smillert { 1634b39c5158Smillert $tb->_unoverload_str( \$e1, \$e2 ); 1635b39c5158Smillert 1636b39c5158Smillert # Either they're both references or both not. 1637b39c5158Smillert my $same_ref = !( !ref $e1 xor !ref $e2 ); 1638b39c5158Smillert my $not_ref = ( !ref $e1 and !ref $e2 ); 1639b39c5158Smillert 1640b39c5158Smillert if( defined $e1 xor defined $e2 ) { 1641b39c5158Smillert $ok = 0; 1642b39c5158Smillert } 1643b39c5158Smillert elsif( !defined $e1 and !defined $e2 ) { 164465d9bffcSjasper # Shortcut if they're both undefined. 1645b39c5158Smillert $ok = 1; 1646b39c5158Smillert } 1647b39c5158Smillert elsif( _dne($e1) xor _dne($e2) ) { 1648b39c5158Smillert $ok = 0; 1649b39c5158Smillert } 1650b39c5158Smillert elsif( $same_ref and( $e1 eq $e2 ) ) { 1651b39c5158Smillert $ok = 1; 1652b39c5158Smillert } 1653b39c5158Smillert elsif($not_ref) { 1654b39c5158Smillert push @Data_Stack, { type => '', vals => [ $e1, $e2 ] }; 1655b39c5158Smillert $ok = 0; 1656b39c5158Smillert } 1657b39c5158Smillert else { 1658b39c5158Smillert if( $Refs_Seen{$e1} ) { 1659b39c5158Smillert return $Refs_Seen{$e1} eq $e2; 1660b39c5158Smillert } 1661b39c5158Smillert else { 1662b39c5158Smillert $Refs_Seen{$e1} = "$e2"; 1663b39c5158Smillert } 1664b39c5158Smillert 1665b39c5158Smillert my $type = _type($e1); 1666b39c5158Smillert $type = 'DIFFERENT' unless _type($e2) eq $type; 1667b39c5158Smillert 1668b39c5158Smillert if( $type eq 'DIFFERENT' ) { 1669b39c5158Smillert push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; 1670b39c5158Smillert $ok = 0; 1671b39c5158Smillert } 1672b39c5158Smillert elsif( $type eq 'ARRAY' ) { 1673b39c5158Smillert $ok = _eq_array( $e1, $e2 ); 1674b39c5158Smillert } 1675b39c5158Smillert elsif( $type eq 'HASH' ) { 1676b39c5158Smillert $ok = _eq_hash( $e1, $e2 ); 1677b39c5158Smillert } 1678b39c5158Smillert elsif( $type eq 'REF' ) { 1679b39c5158Smillert push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; 1680b39c5158Smillert $ok = _deep_check( $$e1, $$e2 ); 1681b39c5158Smillert pop @Data_Stack if $ok; 1682b39c5158Smillert } 1683b39c5158Smillert elsif( $type eq 'SCALAR' ) { 1684b39c5158Smillert push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] }; 1685b39c5158Smillert $ok = _deep_check( $$e1, $$e2 ); 1686b39c5158Smillert pop @Data_Stack if $ok; 1687b39c5158Smillert } 1688b39c5158Smillert elsif($type) { 1689b39c5158Smillert push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; 1690b39c5158Smillert $ok = 0; 1691b39c5158Smillert } 1692b39c5158Smillert else { 1693b39c5158Smillert _whoa( 1, "No type in _deep_check" ); 1694b39c5158Smillert } 1695b39c5158Smillert } 1696b39c5158Smillert } 1697b39c5158Smillert 1698b39c5158Smillert return $ok; 1699b39c5158Smillert} 1700b39c5158Smillert 1701b39c5158Smillertsub _whoa { 1702b39c5158Smillert my( $check, $desc ) = @_; 1703b39c5158Smillert if($check) { 1704b39c5158Smillert die <<"WHOA"; 1705b39c5158SmillertWHOA! $desc 1706b39c5158SmillertThis should never happen! Please contact the author immediately! 1707b39c5158SmillertWHOA 1708b39c5158Smillert } 1709b39c5158Smillert} 1710b39c5158Smillert 1711b39c5158Smillert=item B<eq_hash> 1712b39c5158Smillert 1713b39c5158Smillert my $is_eq = eq_hash(\%got, \%expected); 1714b39c5158Smillert 1715b39c5158SmillertDetermines if the two hashes contain the same keys and values. This 1716b39c5158Smillertis a deep check. 1717b39c5158Smillert 1718b39c5158Smillert=cut 1719b39c5158Smillert 1720b39c5158Smillertsub eq_hash { 1721b39c5158Smillert local @Data_Stack = (); 1722b39c5158Smillert return _deep_check(@_); 1723b39c5158Smillert} 1724b39c5158Smillert 1725b39c5158Smillertsub _eq_hash { 1726b39c5158Smillert my( $a1, $a2 ) = @_; 1727b39c5158Smillert 1728b39c5158Smillert if( grep _type($_) ne 'HASH', $a1, $a2 ) { 1729b39c5158Smillert warn "eq_hash passed a non-hash ref"; 1730b39c5158Smillert return 0; 1731b39c5158Smillert } 1732b39c5158Smillert 1733b39c5158Smillert return 1 if $a1 eq $a2; 1734b39c5158Smillert 1735b39c5158Smillert my $ok = 1; 1736b39c5158Smillert my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2; 1737b39c5158Smillert foreach my $k ( keys %$bigger ) { 1738b39c5158Smillert my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE; 1739b39c5158Smillert my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE; 1740b39c5158Smillert 174165d9bffcSjasper next if _equal_nonrefs($e1, $e2); 174265d9bffcSjasper 1743b39c5158Smillert push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] }; 1744b39c5158Smillert $ok = _deep_check( $e1, $e2 ); 1745b39c5158Smillert pop @Data_Stack if $ok; 1746b39c5158Smillert 1747b39c5158Smillert last unless $ok; 1748b39c5158Smillert } 1749b39c5158Smillert 1750b39c5158Smillert return $ok; 1751b39c5158Smillert} 1752b39c5158Smillert 1753b39c5158Smillert=item B<eq_set> 1754b39c5158Smillert 1755b39c5158Smillert my $is_eq = eq_set(\@got, \@expected); 1756b39c5158Smillert 1757b8851fccSafresh1Similar to C<eq_array()>, except the order of the elements is B<not> 1758b39c5158Smillertimportant. This is a deep check, but the irrelevancy of order only 1759b39c5158Smillertapplies to the top level. 1760b39c5158Smillert 1761b39c5158Smillert ok( eq_set(\@got, \@expected) ); 1762b39c5158Smillert 1763b39c5158SmillertIs better written: 1764b39c5158Smillert 1765b39c5158Smillert is_deeply( [sort @got], [sort @expected] ); 1766b39c5158Smillert 1767b39c5158SmillertB<NOTE> By historical accident, this is not a true set comparison. 1768b39c5158SmillertWhile the order of elements does not matter, duplicate elements do. 1769b39c5158Smillert 1770b8851fccSafresh1B<NOTE> C<eq_set()> does not know how to deal with references at the top 1771b39c5158Smillertlevel. The following is an example of a comparison which might not work: 1772b39c5158Smillert 1773b39c5158Smillert eq_set([\1, \2], [\2, \1]); 1774b39c5158Smillert 1775b39c5158SmillertL<Test::Deep> contains much better set comparison functions. 1776b39c5158Smillert 1777b39c5158Smillert=cut 1778b39c5158Smillert 1779b39c5158Smillertsub eq_set { 1780b39c5158Smillert my( $a1, $a2 ) = @_; 1781b39c5158Smillert return 0 unless @$a1 == @$a2; 1782b39c5158Smillert 1783b39c5158Smillert no warnings 'uninitialized'; 1784b39c5158Smillert 1785b39c5158Smillert # It really doesn't matter how we sort them, as long as both arrays are 1786b39c5158Smillert # sorted with the same algorithm. 1787b39c5158Smillert # 1788b39c5158Smillert # Ensure that references are not accidentally treated the same as a 1789b39c5158Smillert # string containing the reference. 1790b39c5158Smillert # 1791b39c5158Smillert # Have to inline the sort routine due to a threading/sort bug. 1792b39c5158Smillert # See [rt.cpan.org 6782] 1793b39c5158Smillert # 1794b39c5158Smillert # I don't know how references would be sorted so we just don't sort 1795b39c5158Smillert # them. This means eq_set doesn't really work with refs. 1796b39c5158Smillert return eq_array( 1797b39c5158Smillert [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ], 1798b39c5158Smillert [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ], 1799b39c5158Smillert ); 1800b39c5158Smillert} 1801b39c5158Smillert 1802b39c5158Smillert=back 1803b39c5158Smillert 1804b39c5158Smillert 1805b39c5158Smillert=head2 Extending and Embedding Test::More 1806b39c5158Smillert 1807b39c5158SmillertSometimes the Test::More interface isn't quite enough. Fortunately, 1808b8851fccSafresh1Test::More is built on top of L<Test::Builder> which provides a single, 1809b39c5158Smillertunified backend for any test library to use. This means two test 1810e0680481Safresh1libraries which both use L<Test::Builder> B<can> be used together in the 1811e0680481Safresh1same program. 1812b39c5158Smillert 1813b39c5158SmillertIf you simply want to do a little tweaking of how the tests behave, 1814b8851fccSafresh1you can access the underlying L<Test::Builder> object like so: 1815b39c5158Smillert 1816b39c5158Smillert=over 4 1817b39c5158Smillert 1818b39c5158Smillert=item B<builder> 1819b39c5158Smillert 1820b39c5158Smillert my $test_builder = Test::More->builder; 1821b39c5158Smillert 1822b8851fccSafresh1Returns the L<Test::Builder> object underlying Test::More for you to play 1823b39c5158Smillertwith. 1824b39c5158Smillert 1825b39c5158Smillert 1826b39c5158Smillert=back 1827b39c5158Smillert 1828b39c5158Smillert 1829b39c5158Smillert=head1 EXIT CODES 1830b39c5158Smillert 1831b8851fccSafresh1If all your tests passed, L<Test::Builder> will exit with zero (which is 1832b39c5158Smillertnormal). If anything failed it will exit with how many failed. If 1833b39c5158Smillertyou run less (or more) tests than you planned, the missing (or extras) 1834b8851fccSafresh1will be considered failures. If no tests were ever run L<Test::Builder> 1835b39c5158Smillertwill throw a warning and exit with 255. If the test died, even after 1836b39c5158Smillerthaving successfully completed all its tests, it will still be 1837b39c5158Smillertconsidered a failure and will exit with 255. 1838b39c5158Smillert 1839b39c5158SmillertSo the exit codes are... 1840b39c5158Smillert 1841b39c5158Smillert 0 all tests successful 1842b39c5158Smillert 255 test died or all passed but wrong # of tests run 1843b39c5158Smillert any other number how many failed (including missing or extras) 1844b39c5158Smillert 1845b39c5158SmillertIf you fail more than 254 tests, it will be reported as 254. 1846b39c5158Smillert 1847b39c5158SmillertB<NOTE> This behavior may go away in future versions. 1848b39c5158Smillert 1849b39c5158Smillert 1850e5157e49Safresh1=head1 COMPATIBILITY 1851e5157e49Safresh1 1852e5157e49Safresh1Test::More works with Perls as old as 5.8.1. 1853e5157e49Safresh1 1854e5157e49Safresh1Thread support is not very reliable before 5.10.1, but that's 1855e5157e49Safresh1because threads are not very reliable before 5.10.1. 1856e5157e49Safresh1 1857e5157e49Safresh1Although Test::More has been a core module in versions of Perl since 5.6.2, Test::More has evolved since then, and not all of the features you're used to will be present in the shipped version of Test::More. If you are writing a module, don't forget to indicate in your package metadata the minimum version of Test::More that you require. For instance, if you want to use C<done_testing()> but want your test script to run on Perl 5.10.0, you will need to explicitly require Test::More > 0.88. 1858e5157e49Safresh1 1859e5157e49Safresh1Key feature milestones include: 1860b39c5158Smillert 1861b39c5158Smillert=over 4 1862b39c5158Smillert 1863e5157e49Safresh1=item subtests 1864b39c5158Smillert 1865e5157e49Safresh1Subtests were released in Test::More 0.94, which came with Perl 5.12.0. Subtests did not implicitly call C<done_testing()> until 0.96; the first Perl with that fix was Perl 5.14.0 with 0.98. 1866b39c5158Smillert 1867e5157e49Safresh1=item C<done_testing()> 1868e5157e49Safresh1 1869e5157e49Safresh1This was released in Test::More 0.88 and first shipped with Perl in 5.10.1 as part of Test::More 0.92. 1870e5157e49Safresh1 1871e5157e49Safresh1=item C<cmp_ok()> 1872e5157e49Safresh1 1873e5157e49Safresh1Although C<cmp_ok()> was introduced in 0.40, 0.86 fixed an important bug to make it safe for overloaded objects; the fixed first shipped with Perl in 5.10.1 as part of Test::More 0.92. 1874e5157e49Safresh1 1875e5157e49Safresh1=item C<new_ok()> C<note()> and C<explain()> 1876e5157e49Safresh1 1877e5157e49Safresh1These were was released in Test::More 0.82, and first shipped with Perl in 5.10.1 as part of Test::More 0.92. 1878e5157e49Safresh1 1879e5157e49Safresh1=back 1880e5157e49Safresh1 1881e5157e49Safresh1There is a full version history in the Changes file, and the Test::More versions included as core can be found using L<Module::CoreList>: 1882e5157e49Safresh1 1883e5157e49Safresh1 $ corelist -a Test::More 1884e5157e49Safresh1 1885e5157e49Safresh1 1886e5157e49Safresh1=head1 CAVEATS and NOTES 1887e5157e49Safresh1 1888e5157e49Safresh1=over 4 1889b39c5158Smillert 1890b39c5158Smillert=item utf8 / "Wide character in print" 1891b39c5158Smillert 1892b39c5158SmillertIf you use utf8 or other non-ASCII characters with Test::More you 1893b8851fccSafresh1might get a "Wide character in print" warning. Using 1894b8851fccSafresh1C<< binmode STDOUT, ":utf8" >> will not fix it. 1895b8851fccSafresh1L<Test::Builder> (which powers 1896b39c5158SmillertTest::More) duplicates STDOUT and STDERR. So any changes to them, 189756d68f1eSafresh1including changing their output disciplines, will not be seen by 1898b39c5158SmillertTest::More. 1899b39c5158Smillert 1900e5157e49Safresh1One work around is to apply encodings to STDOUT and STDERR as early 1901e5157e49Safresh1as possible and before Test::More (or any other Test module) loads. 1902e5157e49Safresh1 1903e5157e49Safresh1 use open ':std', ':encoding(utf8)'; 1904e5157e49Safresh1 use Test::More; 1905e5157e49Safresh1 1906e5157e49Safresh1A more direct work around is to change the filehandles used by 1907b8851fccSafresh1L<Test::Builder>. 1908b39c5158Smillert 1909b39c5158Smillert my $builder = Test::More->builder; 1910e5157e49Safresh1 binmode $builder->output, ":encoding(utf8)"; 1911e5157e49Safresh1 binmode $builder->failure_output, ":encoding(utf8)"; 1912e5157e49Safresh1 binmode $builder->todo_output, ":encoding(utf8)"; 1913b39c5158Smillert 1914b39c5158Smillert 1915b39c5158Smillert=item Overloaded objects 1916b39c5158Smillert 1917b8851fccSafresh1String overloaded objects are compared B<as strings> (or in C<cmp_ok()>'s 1918b39c5158Smillertcase, strings or numbers as appropriate to the comparison op). This 1919b39c5158Smillertprevents Test::More from piercing an object's interface allowing 1920b39c5158Smillertbetter blackbox testing. So if a function starts returning overloaded 1921b39c5158Smillertobjects instead of bare strings your tests won't notice the 1922b39c5158Smillertdifference. This is good. 1923b39c5158Smillert 1924b8851fccSafresh1However, it does mean that functions like C<is_deeply()> cannot be used to 1925b39c5158Smillerttest the internals of string overloaded objects. In this case I would 1926b39c5158Smillertsuggest L<Test::Deep> which contains more flexible testing functions for 1927b39c5158Smillertcomplex data structures. 1928b39c5158Smillert 1929b39c5158Smillert 1930b39c5158Smillert=item Threads 1931b39c5158Smillert 1932b8851fccSafresh1Test::More will only be aware of threads if C<use threads> has been done 1933b39c5158SmillertI<before> Test::More is loaded. This is ok: 1934b39c5158Smillert 1935b39c5158Smillert use threads; 1936b39c5158Smillert use Test::More; 1937b39c5158Smillert 1938b39c5158SmillertThis may cause problems: 1939b39c5158Smillert 1940b39c5158Smillert use Test::More 1941b39c5158Smillert use threads; 1942b39c5158Smillert 1943b39c5158Smillert5.8.1 and above are supported. Anything below that has too many bugs. 1944b39c5158Smillert 1945b39c5158Smillert=back 1946b39c5158Smillert 1947b39c5158Smillert 1948b39c5158Smillert=head1 HISTORY 1949b39c5158Smillert 1950b8851fccSafresh1This is a case of convergent evolution with Joshua Pritikin's L<Test> 1951b39c5158Smillertmodule. I was largely unaware of its existence when I'd first 1952b8851fccSafresh1written my own C<ok()> routines. This module exists because I can't 1953b39c5158Smillertfigure out how to easily wedge test names into Test's interface (along 1954b39c5158Smillertwith a few other problems). 1955b39c5158Smillert 1956b39c5158SmillertThe goal here is to have a testing utility that's simple to learn, 1957b39c5158Smillertquick to use and difficult to trip yourself up with while still 1958b39c5158Smillertproviding more flexibility than the existing Test.pm. As such, the 1959b39c5158Smillertnames of the most common routines are kept tiny, special cases and 1960b39c5158Smillertmagic side-effects are kept to a minimum. WYSIWYG. 1961b39c5158Smillert 1962b39c5158Smillert 1963b39c5158Smillert=head1 SEE ALSO 1964b39c5158Smillert 1965b8851fccSafresh1=head2 1966b8851fccSafresh1 1967b8851fccSafresh1=head2 ALTERNATIVES 1968b8851fccSafresh1 1969b46d8ef2Safresh1L<Test2::Suite> is the most recent and modern set of tools for testing. 1970b46d8ef2Safresh1 1971b39c5158SmillertL<Test::Simple> if all this confuses you and you just want to write 1972b39c5158Smillertsome tests. You can upgrade to Test::More later (it's forward 1973b39c5158Smillertcompatible). 1974b39c5158Smillert 1975b39c5158SmillertL<Test::Legacy> tests written with Test.pm, the original testing 1976b39c5158Smillertmodule, do not play well with other testing libraries. Test::Legacy 1977b39c5158Smillertemulates the Test.pm interface and does play well with others. 1978b39c5158Smillert 1979b8851fccSafresh1=head2 ADDITIONAL LIBRARIES 1980b8851fccSafresh1 1981b39c5158SmillertL<Test::Differences> for more ways to test complex data structures. 1982b39c5158SmillertAnd it plays well with Test::More. 1983b39c5158Smillert 1984b39c5158SmillertL<Test::Class> is like xUnit but more perlish. 1985b39c5158Smillert 1986b39c5158SmillertL<Test::Deep> gives you more powerful complex data structure testing. 1987b39c5158Smillert 1988b39c5158SmillertL<Test::Inline> shows the idea of embedded testing. 1989b39c5158Smillert 1990b8851fccSafresh1L<Mock::Quick> The ultimate mocking library. Easily spawn objects defined on 1991b8851fccSafresh1the fly. Can also override, block, or reimplement packages as needed. 1992b8851fccSafresh1 1993b8851fccSafresh1L<Test::FixtureBuilder> Quickly define fixture data for unit tests. 1994b8851fccSafresh1 1995b8851fccSafresh1=head2 OTHER COMPONENTS 1996b8851fccSafresh1 1997b8851fccSafresh1L<Test::Harness> is the test runner and output interpreter for Perl. 1998b8851fccSafresh1It's the thing that powers C<make test> and where the C<prove> utility 1999b8851fccSafresh1comes from. 2000b8851fccSafresh1 2001b8851fccSafresh1=head2 BUNDLES 2002b8851fccSafresh1 2003b8851fccSafresh1L<Test::Most> Most commonly needed test functions and features. 2004b39c5158Smillert 2005b39c5158Smillert=head1 AUTHORS 2006b39c5158Smillert 2007b39c5158SmillertMichael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration 2008b39c5158Smillertfrom Joshua Pritikin's Test module and lots of help from Barrie 2009b39c5158SmillertSlaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and 2010b39c5158Smillertthe perl-qa gang. 2011b39c5158Smillert 2012b8851fccSafresh1=head1 MAINTAINERS 2013b8851fccSafresh1 2014b8851fccSafresh1=over 4 2015b8851fccSafresh1 2016b8851fccSafresh1=item Chad Granum E<lt>exodist@cpan.orgE<gt> 2017b8851fccSafresh1 2018b8851fccSafresh1=back 2019b8851fccSafresh1 2020b39c5158Smillert 2021b39c5158Smillert=head1 BUGS 2022b39c5158Smillert 2023*3d61058aSafresh1See L<https://github.com/Test-More/test-more/issues> to report and view bugs. 2024b39c5158Smillert 2025b39c5158Smillert 2026b39c5158Smillert=head1 SOURCE 2027b39c5158Smillert 2028b39c5158SmillertThe source code repository for Test::More can be found at 2029*3d61058aSafresh1L<https://github.com/Test-More/test-more/>. 2030b39c5158Smillert 2031b39c5158Smillert 2032b39c5158Smillert=head1 COPYRIGHT 2033b39c5158Smillert 2034b39c5158SmillertCopyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>. 2035b39c5158Smillert 2036b39c5158SmillertThis program is free software; you can redistribute it and/or 2037b39c5158Smillertmodify it under the same terms as Perl itself. 2038b39c5158Smillert 2039*3d61058aSafresh1See L<https://dev.perl.org/licenses/> 2040b39c5158Smillert 2041b39c5158Smillert=cut 2042b39c5158Smillert 2043b39c5158Smillert1; 2044