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