1use strict; 2use warnings; 3# HARNESS-NO-PRELOAD 4# HARNESS-NO-STREAM 5 6my $CLASS; 7my %BEFORE_LOAD; 8 9BEGIN { 10 my $old = select STDOUT; 11 $BEFORE_LOAD{STDOUT} = $|; 12 select STDERR; 13 $BEFORE_LOAD{STDERR} = $|; 14 select $old; 15 16 require Test2::Formatter::TAP; 17 $CLASS = 'Test2::Formatter::TAP'; 18 *OUT_STD = $CLASS->can('OUT_STD') or die "Could not get OUT_STD constant"; 19 *OUT_ERR = $CLASS->can('OUT_ERR') or die "Could not get OUT_ERR constant"; 20} 21 22use Test2::Tools::Tiny; 23use Test2::API qw/context/; 24 25BEGIN { 26 eval { 27 require PerlIO; 28 PerlIO->VERSION(1.02); # required for PerlIO::get_layers 29 } or do { 30 print "1..0 # SKIP Don't have PerlIO 1.02\n"; 31 exit 0; 32 } 33} 34 35sub grabber { 36 my ($std, $err); 37 open(my $stdh, '>', \$std) || die "Ooops"; 38 open(my $errh, '>', \$err) || die "Ooops"; 39 40 my $it = $CLASS->new( 41 handles => [$stdh, $errh, $stdh], 42 ); 43 44 return ($it, \$std, \$err); 45} 46 47tests "IO handle stuff" => sub { 48 ok($CLASS->can($_), "$CLASS has the '$_' method") for qw/no_numbers handles/; 49 ok($CLASS->isa('Test2::Formatter'), "$CLASS isa Test2::Formatter"); 50 51 ok(!$BEFORE_LOAD{STDOUT}, "AUTOFLUSH was not on for STDOUT before load"); 52 ok(!$BEFORE_LOAD{STDERR}, "AUTOFLUSH was not on for STDERR before load"); 53 my $old = select STDOUT; 54 ok($|, "AUTOFLUSH was turned on for STDOUT"); 55 select STDERR; 56 ok($|, "AUTOFLUSH was turned on for STDERR"); 57 select $old; 58 59 ok(my $one = $CLASS->new, "Created a new instance"); 60 my $handles = $one->handles; 61 is(@$handles, 2, "Got 2 handles"); 62 ok($handles->[0] != $handles->[1], "First and second handles are not the same"); 63 my $layers = {map { $_ => 1 } PerlIO::get_layers($handles->[0])}; 64 65 if (${^UNICODE} & 2) { # 2 means STDIN 66 ok($layers->{utf8}, "'S' is set in PERL_UNICODE, or in -C, honor it, utf8 should be on"); 67 } 68 else { 69 ok(!$layers->{utf8}, "Not utf8 by default"); 70 } 71 72 $one->encoding('utf8'); 73 is($one->encoding, 'utf8', "Got encoding"); 74 $handles = $one->handles; 75 is(@$handles, 2, "Got 2 handles"); 76 $layers = {map { $_ => 1 } PerlIO::get_layers($handles->[OUT_STD])}; 77 ok($layers->{utf8}, "Now utf8"); 78 79 my $two = $CLASS->new(encoding => 'utf8'); 80 $handles = $two->handles; 81 is(@$handles, 2, "Got 2 handles"); 82 $layers = {map { $_ => 1 } PerlIO::get_layers($handles->[OUT_STD])}; 83 ok($layers->{utf8}, "Now utf8"); 84 85 $old = select $handles->[OUT_STD]; 86 ok($|, "AUTOFLUSH was turned on for copy-STDOUT"); 87 select select $handles->[OUT_ERR]; 88 ok($|, "AUTOFLUSH was turned on for copy-STDERR"); 89 select $old; 90 91 ok($CLASS->hide_buffered, "TAP will hide buffered events"); 92 ok(!$CLASS->no_subtest_space, "Default formatter does not have subtest space"); 93}; 94 95tests optimal_pass => sub { 96 my ($it, $out, $err) = grabber(); 97 98 my $fail = Test2::Event::Fail->new; 99 ok(!$it->print_optimal_pass($fail, 1), "Not gonna print a non-pass"); 100 101 $fail = Test2::Event::Ok->new(pass => 0); 102 ok(!$it->print_optimal_pass($fail, 1), "Not gonna print a non-pass"); 103 104 my $pass = Test2::Event::Pass->new(); 105 $pass->add_amnesty({tag => 'foo', details => 'foo'}); 106 ok(!$it->print_optimal_pass($pass, 1), "Not gonna print amnesty"); 107 108 $pass = Test2::Event::Ok->new(pass => 1, todo => ''); 109 ok(!$it->print_optimal_pass($pass, 1), "Not gonna print todo (even empty todo)"); 110 111 $pass = Test2::Event::Ok->new(pass => 1, name => "foo # bar"); 112 ok(!$it->print_optimal_pass($pass, 1), "Not gonna pritn a name with a hash"); 113 114 $pass = Test2::Event::Ok->new(pass => 1, name => "foo \n bar"); 115 ok(!$it->print_optimal_pass($pass, 1), "Not gonna pritn a name with a newline"); 116 117 ok(!$$out, "No std output yet"); 118 ok(!$$err, "No err output yet"); 119 120 $pass = Test2::Event::Pass->new(); 121 ok($it->print_optimal_pass($pass, 1), "Printed a simple pass without a name"); 122 123 $pass = Test2::Event::Pass->new(name => 'xxx'); 124 ok($it->print_optimal_pass($pass, 1), "Printed a simple pass with a name"); 125 126 $pass = Test2::Event::Ok->new(pass => 1, name => 'xxx'); 127 ok($it->print_optimal_pass($pass, 1), "Printed an 'Ok' pass with a name"); 128 129 $pass = Test2::Event::Pass->new(name => 'xxx', trace => {nested => 1}); 130 ok($it->print_optimal_pass($pass, 1), "Printed a nested pass"); 131 $pass = Test2::Event::Pass->new(name => 'xxx', trace => {nested => 3}); 132 ok($it->print_optimal_pass($pass, 1), "Printed a deeply nested pass"); 133 134 $pass = Test2::Event::Pass->new(name => 'xxx'); 135 $it->{no_numbers} = 1; 136 ok($it->print_optimal_pass($pass, 1), "Printed a simple pass with a name"); 137 138 is($$out, <<" EOT", "Got expected TAP output"); 139ok 1 140ok 1 - xxx 141ok 1 - xxx 142 ok 1 - xxx 143 ok 1 - xxx 144ok - xxx 145 EOT 146 147 is($it->{_last_fh}, $it->handles->[OUT_STD], "Set the last filehandle"); 148 149 ok(!$$err, "No err output"); 150}; 151 152tests plan_tap => sub { 153 my ($it, $out, $err) = grabber(); 154 155 is_deeply([$it->plan_tap({})], [], "Nothing with no plan facet"); 156 157 is_deeply( 158 [$it->plan_tap({plan => {none => 1}})], 159 [], 160 "no-plan has no output" 161 ); 162 163 is_deeply( 164 [$it->plan_tap({plan => {count => 20}})], 165 [[OUT_STD, "1..20\n"]], 166 "Wrote the plan from, count" 167 ); 168 169 is_deeply( 170 [$it->plan_tap({plan => {count => 'anything', skip => 1}})], 171 [[OUT_STD, "1..0 # SKIP\n"]], 172 "Skip, no reason" 173 ); 174 175 is_deeply( 176 [$it->plan_tap({plan => {count => 'anything', skip => 1, details => 'I said so'}})], 177 [[OUT_STD, "1..0 # SKIP I said so\n"]], 178 "Skip with reason" 179 ); 180 181 ok(!$$out, "No std output yet"); 182 ok(!$$err, "No err output yet"); 183}; 184 185tests assert_tap => sub { 186 my ($it, $out, $err) = grabber(); 187 188 is_deeply( 189 [$it->assert_tap({assert => {pass => 1}}, 1)], 190 [[OUT_STD, "ok 1\n"]], 191 "Pass", 192 ); 193 194 is_deeply( 195 [$it->assert_tap({assert => {pass => 0}}, 1)], 196 [[OUT_STD, "not ok 1\n"]], 197 "Fail", 198 ); 199 200 tests amnesty => sub { 201 tests pass_no_name => sub { 202 is_deeply( 203 [$it->assert_tap({assert => {pass => 1}, amnesty => [{tag => 'skip', details => 'xxx'}]}, 1)], 204 [[OUT_STD, "ok 1 # skip xxx\n"]], 205 "Pass with skip (with details)", 206 ); 207 208 is_deeply( 209 [$it->assert_tap({assert => {pass => 1}, amnesty => [{tag => 'skip'}]}, 1)], 210 [[OUT_STD, "ok 1 # skip\n"]], 211 "Pass with skip (without details)", 212 ); 213 214 is_deeply( 215 [$it->assert_tap({assert => {pass => 1}, amnesty => [{tag => 'TODO', details => 'xxx'}]}, 1)], 216 [[OUT_STD, "ok 1 # TODO xxx\n"]], 217 "Pass with TODO (with details)", 218 ); 219 220 is_deeply( 221 [$it->assert_tap({assert => {pass => 1}, amnesty => [{tag => 'TODO'}]}, 1)], 222 [[OUT_STD, "ok 1 # TODO\n"]], 223 "Pass with TODO (without details)", 224 ); 225 226 is_deeply( 227 [ 228 $it->assert_tap( 229 { 230 assert => {pass => 1}, 231 amnesty => [ 232 {tag => 'TODO', details => 'xxx'}, 233 {tag => 'skip', details => 'yyy'}, 234 ] 235 }, 236 1 237 ) 238 ], 239 [[OUT_STD, "ok 1 # TODO & SKIP yyy\n"]], 240 "Pass with skip and TODO", 241 ); 242 243 is_deeply( 244 [$it->assert_tap({assert => {pass => 1}, amnesty => [{tag => 'foo', details => 'xxx'}]}, 1)], 245 [[OUT_STD, "ok 1 # foo xxx\n"]], 246 "Pass with other amnesty", 247 ); 248 }; 249 250 tests pass_with_name => sub { 251 is_deeply( 252 [$it->assert_tap({assert => {pass => 1, details => 'bob'}, amnesty => [{tag => 'skip', details => 'xxx'}]}, 1)], 253 [[OUT_STD, "ok 1 - bob # skip xxx\n"]], 254 "Pass with skip (with details)", 255 ); 256 257 is_deeply( 258 [$it->assert_tap({assert => {pass => 1, details => 'bob'}, amnesty => [{tag => 'skip'}]}, 1)], 259 [[OUT_STD, "ok 1 - bob # skip\n"]], 260 "Pass with skip (without details)", 261 ); 262 263 is_deeply( 264 [$it->assert_tap({assert => {pass => 1, details => 'bob'}, amnesty => [{tag => 'TODO', details => 'xxx'}]}, 1)], 265 [[OUT_STD, "ok 1 - bob # TODO xxx\n"]], 266 "Pass with TODO (with details)", 267 ); 268 269 is_deeply( 270 [$it->assert_tap({assert => {pass => 1, details => 'bob'}, amnesty => [{tag => 'TODO'}]}, 1)], 271 [[OUT_STD, "ok 1 - bob # TODO\n"]], 272 "Pass with TODO (without details)", 273 ); 274 275 is_deeply( 276 [ 277 $it->assert_tap( 278 { 279 assert => {pass => 1, details => 'bob'}, 280 amnesty => [ 281 {tag => 'TODO', details => 'xxx'}, 282 {tag => 'skip', details => 'yyy'}, 283 ] 284 }, 285 1 286 ) 287 ], 288 [[OUT_STD, "ok 1 - bob # TODO & SKIP yyy\n"]], 289 "Pass with skip and TODO", 290 ); 291 292 is_deeply( 293 [$it->assert_tap({assert => {pass => 1, details => 'bob'}, amnesty => [{tag => 'foo', details => 'xxx'}]}, 1)], 294 [[OUT_STD, "ok 1 - bob # foo xxx\n"]], 295 "Pass with other amnesty", 296 ); 297 }; 298 299 tests fail_no_name => sub { 300 is_deeply( 301 [$it->assert_tap({assert => {pass => 0}, amnesty => [{tag => 'skip', details => 'xxx'}]}, 1)], 302 [[OUT_STD, "not ok 1 # skip xxx\n"]], 303 "Pass with skip (with details)", 304 ); 305 306 is_deeply( 307 [$it->assert_tap({assert => {pass => 0}, amnesty => [{tag => 'skip'}]}, 1)], 308 [[OUT_STD, "not ok 1 # skip\n"]], 309 "Pass with skip (without details)", 310 ); 311 312 is_deeply( 313 [$it->assert_tap({assert => {pass => 0}, amnesty => [{tag => 'TODO', details => 'xxx'}]}, 1)], 314 [[OUT_STD, "not ok 1 # TODO xxx\n"]], 315 "Pass with TODO (with details)", 316 ); 317 318 is_deeply( 319 [$it->assert_tap({assert => {pass => 0}, amnesty => [{tag => 'TODO'}]}, 1)], 320 [[OUT_STD, "not ok 1 # TODO\n"]], 321 "Pass with TODO (without details)", 322 ); 323 324 is_deeply( 325 [ 326 $it->assert_tap( 327 { 328 assert => {pass => 0}, 329 amnesty => [ 330 {tag => 'TODO', details => 'xxx'}, 331 {tag => 'skip', details => 'yyy'}, 332 ] 333 }, 334 1 335 ) 336 ], 337 [[OUT_STD, "not ok 1 # TODO & SKIP yyy\n"]], 338 "Pass with skip and TODO", 339 ); 340 341 is_deeply( 342 [$it->assert_tap({assert => {pass => 0}, amnesty => [{tag => 'foo', details => 'xxx'}]}, 1)], 343 [[OUT_STD, "not ok 1 # foo xxx\n"]], 344 "Pass with other amnesty", 345 ); 346 }; 347 348 tests fail_with_name => sub { 349 is_deeply( 350 [$it->assert_tap({assert => {pass => 0, details => 'bob'}, amnesty => [{tag => 'skip', details => 'xxx'}]}, 1)], 351 [[OUT_STD, "not ok 1 - bob # skip xxx\n"]], 352 "Pass with skip (with details)", 353 ); 354 355 is_deeply( 356 [$it->assert_tap({assert => {pass => 0, details => 'bob'}, amnesty => [{tag => 'skip'}]}, 1)], 357 [[OUT_STD, "not ok 1 - bob # skip\n"]], 358 "Pass with skip (without details)", 359 ); 360 361 is_deeply( 362 [$it->assert_tap({assert => {pass => 0, details => 'bob'}, amnesty => [{tag => 'TODO', details => 'xxx'}]}, 1)], 363 [[OUT_STD, "not ok 1 - bob # TODO xxx\n"]], 364 "Pass with TODO (with details)", 365 ); 366 367 is_deeply( 368 [$it->assert_tap({assert => {pass => 0, details => 'bob'}, amnesty => [{tag => 'TODO'}]}, 1)], 369 [[OUT_STD, "not ok 1 - bob # TODO\n"]], 370 "Pass with TODO (without details)", 371 ); 372 373 is_deeply( 374 [ 375 $it->assert_tap( 376 { 377 assert => {pass => 0, details => 'bob'}, 378 amnesty => [ 379 {tag => 'TODO', details => 'xxx'}, 380 {tag => 'skip', details => 'yyy'}, 381 ] 382 }, 383 1 384 ) 385 ], 386 [[OUT_STD, "not ok 1 - bob # TODO & SKIP yyy\n"]], 387 "Pass with skip and TODO", 388 ); 389 390 is_deeply( 391 [$it->assert_tap({assert => {pass => 0, details => 'bob'}, amnesty => [{tag => 'foo', details => 'xxx'}]}, 1)], 392 [[OUT_STD, "not ok 1 - bob # foo xxx\n"]], 393 "Pass with other amnesty", 394 ); 395 }; 396 }; 397 398 tests newline_and_hash => sub { 399 tests pass => sub { 400 is_deeply( 401 [$it->assert_tap({assert => {pass => 1, details => "foo\nbar"}}, 1)], 402 [ 403 [OUT_STD, "ok 1 - foo\n"], 404 [OUT_STD, "# bar\n"], 405 ], 406 "Pass with newline", 407 ); 408 409 is_deeply( 410 [$it->assert_tap({assert => {pass => 1, details => "foo\nbar"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)], 411 [ 412 [OUT_STD, "ok 1 - foo # baz bat\n"], 413 [OUT_STD, "# bar\n"], 414 ], 415 "Pass with newline and amnesty", 416 ); 417 418 is_deeply( 419 [$it->assert_tap({assert => {pass => 1, details => "foo#bar"}}, 1)], 420 [[OUT_STD, "ok 1 - foo\\#bar\n"]], 421 "Pass with hash", 422 ); 423 424 is_deeply( 425 [$it->assert_tap({assert => {pass => 1, details => "foo#bar"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)], 426 [[OUT_STD, "ok 1 - foo\\#bar # baz bat\n"]], 427 "Pass with hash and amnesty", 428 ); 429 430 is_deeply( 431 [$it->assert_tap({assert => {pass => 1, details => "foo#x\nbar#boo"}}, 1)], 432 [ 433 [OUT_STD, "ok 1 - foo\\#x\n"], 434 [OUT_STD, "# bar#boo\n"], 435 ], 436 "Pass with newline and hash", 437 ); 438 439 is_deeply( 440 [$it->assert_tap({assert => {pass => 1, details => "foo#x\nbar#boo"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)], 441 [ 442 [OUT_STD, "ok 1 - foo\\#x # baz bat\n"], 443 [OUT_STD, "# bar#boo\n"], 444 ], 445 "Pass with newline and hash and amnesty", 446 ); 447 }; 448 449 tests fail => sub { 450 is_deeply( 451 [$it->assert_tap({assert => {pass => 0, details => "foo\nbar"}}, 1)], 452 [ 453 [OUT_STD, "not ok 1 - foo\n"], 454 [OUT_STD, "# bar\n"], 455 ], 456 "Pass with newline", 457 ); 458 459 is_deeply( 460 [$it->assert_tap({assert => {pass => 0, details => "foo\nbar"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)], 461 [ 462 [OUT_STD, "not ok 1 - foo # baz bat\n"], 463 [OUT_STD, "# bar\n"], 464 ], 465 "Pass with newline and amnesty", 466 ); 467 468 is_deeply( 469 [$it->assert_tap({assert => {pass => 0, details => "foo#bar"}}, 1)], 470 [[OUT_STD, "not ok 1 - foo\\#bar\n"]], 471 "Pass with hash", 472 ); 473 474 is_deeply( 475 [$it->assert_tap({assert => {pass => 0, details => "foo#bar"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)], 476 [[OUT_STD, "not ok 1 - foo\\#bar # baz bat\n"]], 477 "Pass with hash and amnesty", 478 ); 479 480 is_deeply( 481 [$it->assert_tap({assert => {pass => 0, details => "foo#x\nbar#boo"}}, 1)], 482 [ 483 [OUT_STD, "not ok 1 - foo\\#x\n"], 484 [OUT_STD, "# bar#boo\n"], 485 ], 486 "Pass with newline and hash", 487 ); 488 489 is_deeply( 490 [$it->assert_tap({assert => {pass => 0, details => "foo#x\nbar#boo"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)], 491 [ 492 [OUT_STD, "not ok 1 - foo\\#x # baz bat\n"], 493 [OUT_STD, "# bar#boo\n"], 494 ], 495 "Pass with newline and hash and amnesty", 496 ); 497 }; 498 }; 499 500 tests parent => sub { 501 is_deeply( 502 [ 503 $it->assert_tap( 504 { 505 assert => {pass => 1, details => 'bob'}, 506 parent => {hid => 1, buffered => 1, children => [{assert => {pass => 1, details => 'bob2'}}]}, 507 }, 508 1 509 ) 510 ], 511 [ 512 [OUT_STD, "ok 1 - bob {\n"], 513 [OUT_STD, " ok 1 - bob2\n"], 514 [OUT_STD, "}\n"], 515 ], 516 "Parent (buffered)", 517 ); 518 519 is_deeply( 520 [ 521 $it->assert_tap( 522 { 523 assert => {pass => 1, details => 'bob'}, 524 parent => {hid => 1, buffered => 0, children => [{assert => {pass => 1, details => 'bob2'}}]}, 525 }, 526 1 527 ) 528 ], 529 [[OUT_STD, "ok 1 - bob\n"]], 530 "Parent (un-buffered)", 531 ); 532 }; 533 534 ok(!$$out, "No std output yet"); 535 ok(!$$err, "No err output yet"); 536}; 537 538tests debug_tap => sub { 539 my ($it, $out, $err) = grabber(); 540 541 is_deeply( 542 [ 543 $it->debug_tap( 544 { 545 assert => {pass => 0}, 546 trace => {frame => ['foo', 'foo.t', 42]}, 547 }, 548 1 549 ) 550 ], 551 [ 552 [OUT_ERR, "# Failed test at foo.t line 42.\n"], 553 ], 554 "debug tap, nameless test" 555 ); 556 557 is_deeply( 558 [ 559 $it->debug_tap( 560 { 561 assert => {details => 'foo bar', pass => 0}, 562 trace => {frame => ['foo', 'foo.t', 42]}, 563 }, 564 1 565 ) 566 ], 567 [ 568 [OUT_ERR, "# Failed test 'foo bar'\n# at foo.t line 42.\n"], 569 ], 570 "Debug tap, named test" 571 ); 572 573 is_deeply( 574 [ 575 $it->debug_tap( 576 { 577 assert => {details => 'foo bar', pass => 0}, 578 trace => {frame => ['foo', 'foo.t', 42], details => 'I say hi!'}, 579 }, 580 1 581 ) 582 ], 583 [ 584 [OUT_ERR, "# Failed test 'foo bar'\n# I say hi!\n"], 585 ], 586 "Debug tap with details" 587 ); 588 589 is_deeply( 590 [ 591 $it->debug_tap( 592 { 593 assert => {details => 'foo bar', pass => 0}, 594 }, 595 1 596 ) 597 ], 598 [ 599 [OUT_ERR, "# Failed test 'foo bar'\n# [No trace info available]\n"], 600 ], 601 "Debug tap no trace" 602 ); 603 604 is_deeply( 605 [ 606 $it->debug_tap( 607 { 608 assert => {details => 'foo bar', pass => 0}, 609 trace => {frame => ['foo', 'foo.t', 42]}, 610 amnesty => [], 611 }, 612 1 613 ) 614 ], 615 [ 616 [OUT_ERR, "# Failed test 'foo bar'\n# at foo.t line 42.\n"], 617 ], 618 "Debug empty amnesty" 619 ); 620 621 is_deeply( 622 [ 623 $it->debug_tap( 624 { 625 assert => {details => 'foo bar', pass => 0}, 626 trace => {frame => ['foo', 'foo.t', 42]}, 627 amnesty => [{tag => 'TODO', details => 'xxx'}], 628 }, 629 1 630 ) 631 ], 632 [ 633 [OUT_STD, "# Failed test (with amnesty) 'foo bar'\n# at foo.t line 42.\n"], 634 ], 635 "Debug empty amnesty" 636 ); 637 638 ok(!$$out, "No std output yet"); 639 ok(!$$err, "No err output yet"); 640 641 my $event = Test2::Event::Fail->new(trace => {frame => ['foo', 'foo.pl', 42]}); 642 643 { 644 local $ENV{HARNESS_ACTIVE} = 0; 645 local $ENV{HARNESS_IS_VERBOSE} = 0; 646 647 $event->{name} = 'no harness'; 648 $it->write($event, 1); 649 650 $ENV{HARNESS_ACTIVE} = 0; 651 $ENV{HARNESS_IS_VERBOSE} = 1; 652 653 $event->{name} = 'no harness, but strangely verbose'; 654 $it->write($event, 1); 655 656 $ENV{HARNESS_ACTIVE} = 1; 657 $ENV{HARNESS_IS_VERBOSE} = 0; 658 659 $event->{name} = 'harness, but not verbose'; 660 $it->write($event, 1); 661 662 $ENV{HARNESS_ACTIVE} = 1; 663 $ENV{HARNESS_IS_VERBOSE} = 1; 664 665 $event->{name} = 'harness that is verbose'; 666 $it->write($event, 1); 667 } 668 669 is($$out, <<" EOT", "Got 4 failures to STDERR"); 670not ok 1 - no harness 671not ok 1 - no harness, but strangely verbose 672not ok 1 - harness, but not verbose 673not ok 1 - harness that is verbose 674 EOT 675 676 is($$err, <<" EOT", "Got expected diag to STDERR, newline for non-verbose harness"); 677# Failed test 'no harness' 678# at foo.pl line 42. 679# Failed test 'no harness, but strangely verbose' 680# at foo.pl line 42. 681 682# Failed test 'harness, but not verbose' 683# at foo.pl line 42. 684 685# Failed test 'harness that is verbose' 686# at foo.pl line 42. 687 EOT 688}; 689 690tests halt_tap => sub { 691 my ($it, $out, $err) = grabber(); 692 693 is_deeply( 694 [$it->halt_tap({trace => {nested => 1},})], 695 [], 696 "No output when nested" 697 ); 698 699 is_deeply( 700 [$it->halt_tap({trace => {nested => 1, buffered => 1}})], 701 [[OUT_STD, "Bail out!\n"]], 702 "Got tap for nested buffered bail" 703 ); 704 705 is_deeply( 706 [$it->halt_tap({control => {details => ''}})], 707 [[OUT_STD, "Bail out!\n"]], 708 "Empty details" 709 ); 710 711 is_deeply( 712 [$it->halt_tap({control => {details => undef}})], 713 [[OUT_STD, "Bail out!\n"]], 714 "undef details" 715 ); 716 717 is_deeply( 718 [$it->halt_tap({control => {details => 0}})], 719 [[OUT_STD, "Bail out! 0\n"]], 720 "falsy details" 721 ); 722 723 is_deeply( 724 [$it->halt_tap({control => {details => 'foo bar baz'}})], 725 [[OUT_STD, "Bail out! foo bar baz\n"]], 726 "full details" 727 ); 728 729 ok(!$$out, "No std output yet"); 730 ok(!$$err, "No err output yet"); 731}; 732 733tests summary_tap => sub { 734 my ($it, $out, $err) = grabber(); 735 736 is_deeply( 737 [$it->summary_tap({about => {no_display => 1, details => "Should not see me"}})], 738 [], 739 "no display" 740 ); 741 742 is_deeply( 743 [$it->summary_tap({about => {no_display => 0, details => ""}})], 744 [], 745 "no summary" 746 ); 747 748 is_deeply( 749 [$it->summary_tap({about => {no_display => 0, details => "foo bar"}})], 750 [[OUT_STD, "# foo bar\n"]], 751 "summary" 752 ); 753 754 ok(!$$out, "No std output yet"); 755 ok(!$$err, "No err output yet"); 756}; 757 758tests info_tap => sub { 759 my ($it, $out, $err) = grabber(); 760 761 is_deeply( 762 [ 763 $it->info_tap( 764 { 765 info => [ 766 {debug => 0, details => "foo"}, 767 {debug => 1, details => "foo"}, 768 {debug => 0, details => "foo\nbar\nbaz"}, 769 {debug => 1, details => "foo\nbar\nbaz"}, 770 ] 771 } 772 ) 773 ], 774 [ 775 [OUT_STD, "# foo\n"], 776 [OUT_ERR, "# foo\n"], 777 [OUT_STD, "# foo\n# bar\n# baz\n"], 778 [OUT_ERR, "# foo\n# bar\n# baz\n"], 779 ], 780 "Got all infos" 781 ); 782 783 my @TAP = $it->info_tap( 784 { 785 info => [ 786 {debug => 0, details => {structure => 'yes'}}, 787 {debug => 1, details => {structure => 'yes'}}, 788 ] 789 } 790 ); 791 792 is($TAP[0]->[0], OUT_STD, "First went to STDOUT"); 793 is($TAP[1]->[0], OUT_ERR, "Second went to STDOUT"); 794 795 like($TAP[0]->[1], qr/structure.*=>.*yes/, "We see the structure in some form"); 796 like($TAP[1]->[1], qr/structure.*=>.*yes/, "We see the structure in some form"); 797 798 ok(!$$out, "No std output yet"); 799 ok(!$$err, "No err output yet"); 800}; 801 802tests error_tap => sub { 803 my ($it, $out, $err) = grabber(); 804 805 # Data::Dumper behavior can change from version to version, specifically 806 # the Data::Dumper in 5.8.9 produces different whitespace from other 807 # versions. 808 require Data::Dumper; 809 my $dumper = Data::Dumper->new([{structure => 'yes'}])->Indent(2)->Terse(1)->Pad('# ')->Useqq(1)->Sortkeys(1); 810 chomp(my $struct = $dumper->Dump); 811 812 is_deeply( 813 [ 814 $it->error_tap( 815 { 816 errors => [ 817 {details => "foo"}, 818 {details => "foo\nbar\nbaz"}, 819 {details => {structure => 'yes'}}, 820 ] 821 } 822 ) 823 ], 824 [ 825 [OUT_ERR, "# foo\n"], 826 [OUT_ERR, "# foo\n# bar\n# baz\n"], 827 [OUT_ERR, "$struct\n"], 828 ], 829 "Got all errors" 830 ); 831 832 ok(!$$out, "No std output yet"); 833 ok(!$$err, "No err output yet"); 834}; 835 836tests event_tap => sub { 837 my ($it, $out, $err) = grabber(); 838 839 is_deeply( 840 [$it->event_tap({plan => {count => 5}, assert => {pass => 1}}, 1)], 841 [ 842 [OUT_STD, "1..5\n"], 843 [OUT_STD, "ok 1\n"], 844 ], 845 "Plan then assertion for first assertion" 846 ); 847 848 $it->{made_assertion} = 1; 849 850 is_deeply( 851 [$it->event_tap({plan => {count => 5}, assert => {pass => 1}}, 2)], 852 [ 853 [OUT_STD, "ok 2\n"], 854 [OUT_STD, "1..5\n"], 855 ], 856 "Assertion then plan for additional assertions" 857 ); 858 859 $it->{made_assertion} = 0; 860 is_deeply( 861 [ 862 $it->event_tap( 863 { 864 plan => {count => 5}, 865 assert => {pass => 0}, 866 errors => [{details => "foo"}], 867 info => [ 868 {tag => 'DIAG', debug => 1, details => 'xxx'}, 869 {tag => 'NOTE', debug => 0, details => 'yyy'}, 870 ], 871 control => {halt => 1, details => 'blah'}, 872 about => {details => 'xyz'}, 873 }, 874 1 875 ) 876 ], 877 [ 878 [OUT_STD, "1..5\n"], 879 [OUT_STD, "not ok 1\n"], 880 [OUT_ERR, "# Failed test [No trace info available]\n"], 881 [OUT_ERR, "# foo\n"], 882 [OUT_ERR, "# xxx\n"], 883 [OUT_STD, "# yyy\n"], 884 [OUT_STD, "Bail out! blah\n"], 885 ], 886 "All facets displayed" 887 ); 888 889 is_deeply( 890 [ 891 $it->event_tap( 892 { 893 plan => {count => 5}, 894 about => {details => 'xyz'}, 895 }, 896 1 897 ) 898 ], 899 [[OUT_STD, "1..5\n"]], 900 "Plan blocks details" 901 ); 902 903 is_deeply( 904 [ 905 $it->event_tap( 906 { 907 assert => {pass => 0, no_debug => 1}, 908 about => {details => 'xyz'}, 909 }, 910 1 911 ) 912 ], 913 [[OUT_STD, "not ok 1\n"]], 914 "Assert blocks details" 915 ); 916 917 is_deeply( 918 [ 919 $it->event_tap( 920 { 921 errors => [{details => "foo"}], 922 about => {details => 'xyz'}, 923 }, 924 1 925 ) 926 ], 927 [[OUT_ERR, "# foo\n"]], 928 "Error blocks details" 929 ); 930 931 is_deeply( 932 [ 933 $it->event_tap( 934 { 935 info => [ 936 {tag => 'DIAG', debug => 1, details => 'xxx'}, 937 {tag => 'NOTE', debug => 0, details => 'yyy'}, 938 ], 939 about => {details => 'xyz'}, 940 }, 941 1 942 ) 943 ], 944 [ 945 [OUT_ERR, "# xxx\n"], 946 [OUT_STD, "# yyy\n"], 947 ], 948 "Info blocks details" 949 ); 950 951 is_deeply( 952 [ 953 $it->event_tap( 954 { 955 control => {halt => 1, details => 'blah'}, 956 about => {details => 'xyz'}, 957 }, 958 1 959 ) 960 ], 961 [[OUT_STD, "Bail out! blah\n"]], 962 "Halt blocks details" 963 ); 964 965 is_deeply( 966 [$it->event_tap({about => {details => 'xyz'}}, 1)], 967 [[OUT_STD, "# xyz\n"]], 968 "Fallback to summary" 969 ); 970 971 ok(!$$out, "No std output yet"); 972 ok(!$$err, "No err output yet"); 973}; 974 975tests write => sub { 976 my ($it, $out, $err) = grabber(); 977 978 local $ENV{HARNESS_ACTIVE} = 0; 979 local $ENV{HARNESS_IS_VERBOSE} = 0; 980 981 { 982 local $\ = 'oops1'; 983 local $, = 'oops2'; 984 $it->write( 985 undef, 1, 986 { 987 plan => {count => 5}, 988 assert => {pass => 0}, 989 errors => [{details => "foo"}], 990 info => [ 991 {tag => 'DIAG', debug => 1, details => 'xxx'}, 992 {tag => 'NOTE', debug => 0, details => 'yyy'}, 993 ], 994 control => {halt => 1, details => 'blah'}, 995 about => {details => 'xyz'}, 996 }, 997 ); 998 999 $it->write(undef, 2, {assert => {pass => 1}, trace => {nested => 1}}); 1000 } 1001 1002 is($it->{_last_fh}, $it->handles->[OUT_STD], "Set last handle"); 1003 1004 is($$out, <<" EOT", "STDOUT is as expected"); 10051..5 1006not ok 1 1007# yyy 1008Bail out! blah 1009 ok 2 1010 EOT 1011 1012 is($$err, <<" EOT", "STDERR is as expected"); 1013# Failed test [No trace info available] 1014# foo 1015# xxx 1016 EOT 1017}; 1018 1019my $can_table = $CLASS->supports_tables; 1020my $author_testing = $ENV{AUTHOR_TESTING}; 1021 1022if ($author_testing && !$can_table) { 1023 die "You are running this test under AUTHOR_TESTING, doing so requires Term::Table to be installed, but it is not currently installed, this is a fatal error. Please install Term::Table before attempting to run this test under AUTHOR_TESTING."; 1024} 1025elsif ($can_table) { 1026 tests tables => sub { 1027 my ($it, $out, $err) = grabber(); 1028 1029 no warnings 'redefine'; 1030 local *Term::Table::Util::term_size = sub { 70 }; 1031 1032 my %table_data = ( 1033 header => ['H1', 'H2'], 1034 rows => [ 1035 ["R1C1\n", 'R1C2'], 1036 ['R2C1', 'R2C2'], 1037 [('x' x 30), ('y' x 30)], 1038 ], 1039 ); 1040 1041 { 1042 local *Test2::Formatter::TAP::supports_tables = sub { 0 }; 1043 $it->write( 1044 undef, 1, { 1045 info => [ 1046 { 1047 tag => 'DIAG', 1048 details => 'should see only this', 1049 debug => 1, 1050 table => \%table_data, 1051 }, 1052 { 1053 tag => 'NOTE', 1054 details => 'should see only this', 1055 table => \%table_data, 1056 }, 1057 ] 1058 }, 1059 ); 1060 } 1061 1062 $it->write( 1063 undef, 1, { 1064 info => [ 1065 { 1066 tag => 'DIAG', 1067 details => 'should not see', 1068 debug => 1, 1069 table => \%table_data, 1070 }, 1071 { 1072 tag => 'NOTE', 1073 details => 'should not see', 1074 table => \%table_data, 1075 }, 1076 ] 1077 }, 1078 ); 1079 1080 $it->write( 1081 undef, 1, { 1082 trace => {nested => 2}, 1083 info => [ 1084 { 1085 tag => 'DIAG', 1086 details => 'should not see', 1087 debug => 1, 1088 table => \%table_data, 1089 }, 1090 { 1091 tag => 'NOTE', 1092 details => 'should not see', 1093 table => \%table_data, 1094 }, 1095 ] 1096 }, 1097 ); 1098 1099 my $table1 = join "\n" => map { "# $_" } Term::Table->new( 1100 %table_data, 1101 max_width => Term::Table::Util::term_size() - 2, # 2 for '# ' 1102 collapse => 1, 1103 sanitize => 1, 1104 mark_tail => 1, 1105 )->render; 1106 1107 my $table2 = join "\n" => map { " # $_" } Term::Table->new( 1108 %table_data, 1109 max_width => Term::Table::Util::term_size() - 10, # 2 for '# ', 8 for indentation 1110 collapse => 1, 1111 sanitize => 1, 1112 mark_tail => 1, 1113 )->render; 1114 1115 is($$out, <<" EOT", "Showed detail OR tables, properly sized and indented in STDOUT"); 1116# should see only this 1117$table1 1118$table2 1119 EOT 1120 1121 is($$err, <<" EOT", "Showed detail OR tables, properly sized and indented in STDERR"); 1122# should see only this 1123$table1 1124$table2 1125 EOT 1126 }; 1127} 1128 1129done_testing; 1130