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