lib/Test/Harness/t/parse.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 BEGIN {
   6     if( $ENV{PERL_CORE} ) {
   7         chdir 't';
   8         @INC = ('../lib', 'lib');
   9     }
  10     else {
  11         use lib 't/lib';
  12     }
  13 }
  14
  15 use Test::More tests => 260;
  16 use IO::c55Capture;
  17
  18 use File::Spec;
  19
  20 use TAP::Parser;
  21 use TAP::Parser::Iterator;
  22
  23 sub _get_results {
  24     my $parser = shift;
  25     my @results;
  26     while ( defined( my $result = $parser->next ) ) {
  27         push @results => $result;
  28     }
  29     return @results;
  30 }
  31
  32 my ( $PARSER, $PLAN, $TEST, $COMMENT, $BAILOUT, $UNKNOWN, $YAML, $VERSION ) = qw(
  33   TAP::Parser
  34   TAP::Parser::Result::Plan
  35   TAP::Parser::Result::Test
  36   TAP::Parser::Result::Comment
  37   TAP::Parser::Result::Bailout
  38   TAP::Parser::Result::Unknown
  39   TAP::Parser::Result::YAML
  40   TAP::Parser::Result::Version
  41 );
  42
  43 my $tap = <<'END_TAP';
  44 TAP version 13
  45 1..7
  46 ok 1 - input file opened
  47 ... this is junk
  48 not ok first line of the input valid # todo some data
  49 # this is a comment
  50 ok 3 - read the rest of the file
  51 not ok 4 - this is a real failure
  52   --- YAML!
  53   ...
  54 ok 5 # skip we have no description
  55 ok 6 - you shall not pass! # TODO should have failed
  56 not ok 7 - Gandalf wins.  Game over.  # TODO 'bout time!
  57 END_TAP
  58
  59 can_ok $PARSER, 'new';
  60 my $parser = $PARSER->new( { tap => $tap } );
  61 isa_ok $parser, $PARSER, '... and the object it returns';
  62
  63 ok $ENV{TAP_VERSION}, 'TAP_VERSION env variable should be set';
  64
  65 # results() is sane?
  66
  67 my @results = _get_results($parser);
  68 is scalar @results, 12, '... and there should be one for each line';
  69
  70 my $version = shift @results;
  71 isa_ok $version, $VERSION;
  72 is $version->version, '13', '... and the version should be 13';
  73
  74 # check the test plan
  75
  76 my $result = shift @results;
  77 isa_ok $result, $PLAN;
  78 can_ok $result, 'type';
  79 is $result->type, 'plan', '... and it should report the correct type';
  80 ok $result->is_plan, '... and it should identify itself as a plan';
  81 is $result->plan, '1..7', '... and identify the plan';
  82 ok !$result->directive,   '... and this plan should not have a directive';
  83 ok !$result->explanation, '... or a directive explanation';
  84 is $result->as_string, '1..7',
  85   '... and have the correct string representation';
  86 is $result->raw, '1..7', '... and raw() should return the original line';
  87
  88 # a normal, passing test
  89
  90 my $test = shift @results;
  91 isa_ok $test, $TEST;
  92 is $test->type, 'test', '... and it should report the correct type';
  93 ok $test->is_test, '... and it should identify itself as a test';
  94 is $test->ok,      'ok', '... and it should have the correct ok()';
  95 ok $test->is_ok,   '... and the correct boolean version of is_ok()';
  96 ok $test->is_actual_ok,
  97   '... and the correct boolean version of is_actual_ok()';
  98 is $test->number, 1, '... and have the correct test number';
  99 is $test->description, '- input file opened',
 100   '... and the correct description';
 101 ok !$test->directive,   '... and not have a directive';
 102 ok !$test->explanation, '... or a directive explanation';
 103 ok !$test->has_skip,    '... and it is not a SKIPped test';
 104 ok !$test->has_todo,    '... nor a TODO test';
 105 is $test->as_string, 'ok 1 - input file opened',
 106   '... and its string representation should be correct';
 107 is $test->raw, 'ok 1 - input file opened',
 108   '... and raw() should return the original line';
 109
 110 # junk lines should be preserved
 111
 112 my $unknown = shift @results;
 113 isa_ok $unknown, $UNKNOWN;
 114 is $unknown->type, 'unknown', '... and it should report the correct type';
 115 ok $unknown->is_unknown, '... and it should identify itself as unknown';
 116 is $unknown->as_string,  '... this is junk',
 117   '... and its string representation should be returned verbatim';
 118 is $unknown->raw, '... this is junk',
 119   '... and raw() should return the original line';
 120
 121 # a failing test, which also happens to have a directive
 122
 123 my $failed = shift @results;
 124 isa_ok $failed, $TEST;
 125 is $failed->type, 'test', '... and it should report the correct type';
 126 ok $failed->is_test, '... and it should identify itself as a test';
 127 is $failed->ok,      'not ok', '... and it should have the correct ok()';
 128 ok $failed->is_ok,   '... and TODO tests should always pass';
 129 ok !$failed->is_actual_ok,
 130   '... and the correct boolean version of is_actual_ok ()';
 131 is $failed->number, 2, '... and have the correct failed number';
 132 is $failed->description, 'first line of the input valid',
 133   '... and the correct description';
 134 is $failed->directive, 'TODO', '... and should have the correct directive';
 135 is $failed->explanation, 'some data',
 136   '... and the correct directive explanation';
 137 ok !$failed->has_skip, '... and it is not a SKIPped failed';
 138 ok $failed->has_todo, '... but it is a TODO succeeded';
 139 is $failed->as_string,
 140   'not ok 2 first line of the input valid # TODO some data',
 141   '... and its string representation should be correct';
 142 is $failed->raw, 'not ok first line of the input valid # todo some data',
 143   '... and raw() should return the original line';
 144
 145 # comments
 146
 147 my $comment = shift @results;
 148 isa_ok $comment, $COMMENT;
 149 is $comment->type, 'comment', '... and it should report the correct type';
 150 ok $comment->is_comment, '... and it should identify itself as a comment';
 151 is $comment->comment,    'this is a comment',
 152   '... and you should be able to fetch the comment';
 153 is $comment->as_string, '# this is a comment',
 154   '... and have the correct string representation';
 155 is $comment->raw, '# this is a comment',
 156   '... and raw() should return the original line';
 157
 158 # another normal, passing test
 159
 160 $test = shift @results;
 161 isa_ok $test, $TEST;
 162 is $test->type, 'test', '... and it should report the correct type';
 163 ok $test->is_test, '... and it should identify itself as a test';
 164 is $test->ok,      'ok', '... and it should have the correct ok()';
 165 ok $test->is_ok,   '... and the correct boolean version of is_ok()';
 166 ok $test->is_actual_ok,
 167   '... and the correct boolean version of is_actual_ok()';
 168 is $test->number, 3, '... and have the correct test number';
 169 is $test->description, '- read the rest of the file',
 170   '... and the correct description';
 171 ok !$test->directive,   '... and not have a directive';
 172 ok !$test->explanation, '... or a directive explanation';
 173 ok !$test->has_skip,    '... and it is not a SKIPped test';
 174 ok !$test->has_todo,    '... nor a TODO test';
 175 is $test->as_string, 'ok 3 - read the rest of the file',
 176   '... and its string representation should be correct';
 177 is $test->raw, 'ok 3 - read the rest of the file',
 178   '... and raw() should return the original line';
 179
 180 # a failing test
 181
 182 $failed = shift @results;
 183 isa_ok $failed, $TEST;
 184 is $failed->type, 'test', '... and it should report the correct type';
 185 ok $failed->is_test, '... and it should identify itself as a test';
 186 is $failed->ok, 'not ok', '... and it should have the correct ok()';
 187 ok !$failed->is_ok, '... and the tests should not have passed';
 188 ok !$failed->is_actual_ok,
 189   '... and the correct boolean version of is_actual_ok ()';
 190 is $failed->number, 4, '... and have the correct failed number';
 191 is $failed->description, '- this is a real failure',
 192   '... and the correct description';
 193 ok !$failed->directive,   '... and should have no directive';
 194 ok !$failed->explanation, '... and no directive explanation';
 195 ok !$failed->has_skip,    '... and it is not a SKIPped failed';
 196 ok !$failed->has_todo,    '... and not a TODO test';
 197 is $failed->as_string, 'not ok 4 - this is a real failure',
 198   '... and its string representation should be correct';
 199 is $failed->raw, 'not ok 4 - this is a real failure',
 200   '... and raw() should return the original line';
 201
 202 # Some YAML
 203 my $yaml = shift @results;
 204 isa_ok $yaml, $YAML;
 205 is $yaml->type, 'yaml', '... and it should report the correct type';
 206 ok $yaml->is_yaml, '... and it should identify itself as yaml';
 207 is_deeply $yaml->data, 'YAML!', '... and data should be correct';
 208
 209 # ok 5 # skip we have no description
 210 # skipped test
 211
 212 $test = shift @results;
 213 isa_ok $test, $TEST;
 214 is $test->type, 'test', '... and it should report the correct type';
 215 ok $test->is_test, '... and it should identify itself as a test';
 216 is $test->ok,      'ok', '... and it should have the correct ok()';
 217 ok $test->is_ok,   '... and the correct boolean version of is_ok()';
 218 ok $test->is_actual_ok,
 219   '... and the correct boolean version of is_actual_ok()';
 220 is $test->number, 5, '... and have the correct test number';
 221 ok !$test->description, '... and skipped tests have no description';
 222 is $test->directive, 'SKIP', '... and teh correct directive';
 223 is $test->explanation, 'we have no description',
 224   '... but we should have an explanation';
 225 ok $test->has_skip, '... and it is a SKIPped test';
 226 ok !$test->has_todo, '... but not a TODO test';
 227 is $test->as_string, 'ok 5 # SKIP we have no description',
 228   '... and its string representation should be correct';
 229 is $test->raw, 'ok 5 # skip we have no description',
 230   '... and raw() should return the original line';
 231
 232 # a failing test, which also happens to have a directive
 233 # ok 6 - you shall not pass! # TODO should have failed
 234
 235 my $bonus = shift @results;
 236 isa_ok $bonus, $TEST;
 237 can_ok $bonus, 'todo_passed';
 238 is $bonus->type, 'test', 'TODO tests should parse correctly';
 239 ok $bonus->is_test, '... and it should identify itself as a test';
 240 is $bonus->ok,      'ok', '... and it should have the correct ok()';
 241 ok $bonus->is_ok,   '... and TODO tests should not always pass';
 242 ok $bonus->is_actual_ok,
 243   '... and the correct boolean version of is_actual_ok ()';
 244 is $bonus->number, 6, '... and have the correct failed number';
 245 is $bonus->description, '- you shall not pass!',
 246   '... and the correct description';
 247 is $bonus->directive, 'TODO', '... and should have the correct directive';
 248 is $bonus->explanation, 'should have failed',
 249   '... and the correct directive explanation';
 250 ok !$bonus->has_skip, '... and it is not a SKIPped failed';
 251 ok $bonus->has_todo,  '... but it is a TODO succeeded';
 252 is $bonus->as_string, 'ok 6 - you shall not pass! # TODO should have failed',
 253   '... and its string representation should be correct';
 254 is $bonus->raw, 'ok 6 - you shall not pass! # TODO should have failed',
 255   '... and raw() should return the original line';
 256 ok $bonus->todo_passed,
 257   '... todo_bonus() should pass for TODO tests which unexpectedly succeed';
 258
 259 # not ok 7 - Gandalf wins.  Game over.  # TODO 'bout time!
 260
 261 my $passed = shift @results;
 262 isa_ok $passed, $TEST;
 263 can_ok $passed, 'todo_passed';
 264 is $passed->type, 'test', 'TODO tests should parse correctly';
 265 ok $passed->is_test, '... and it should identify itself as a test';
 266 is $passed->ok,      'not ok', '... and it should have the correct ok()';
 267 ok $passed->is_ok,   '... and TODO tests should always pass';
 268 ok !$passed->is_actual_ok,
 269   '... and the correct boolean version of is_actual_ok ()';
 270 is $passed->number, 7, '... and have the correct passed number';
 271 is $passed->description, '- Gandalf wins.  Game over.',
 272   '... and the correct description';
 273 is $passed->directive, 'TODO', '... and should have the correct directive';
 274 is $passed->explanation, "'bout time!",
 275   '... and the correct directive explanation';
 276 ok !$passed->has_skip, '... and it is not a SKIPped passed';
 277 ok $passed->has_todo, '... but it is a TODO succeeded';
 278 is $passed->as_string,
 279   "not ok 7 - Gandalf wins.  Game over. # TODO 'bout time!",
 280   '... and its string representation should be correct';
 281 is $passed->raw, "not ok 7 - Gandalf wins.  Game over.  # TODO 'bout time!",
 282   '... and raw() should return the original line';
 283 ok !$passed->todo_passed,
 284   '... todo_passed() should not pass for TODO tests which failed';
 285
 286 # test parse results
 287
 288 can_ok $parser, 'passed';
 289 is $parser->passed, 6,
 290   '... and we should have the correct number of passed tests';
 291 is_deeply [ $parser->passed ], [ 1, 2, 3, 5, 6, 7 ],
 292   '... and get a list of the passed tests';
 293
 294 can_ok $parser, 'failed';
 295 is $parser->failed, 1, '... and the correct number of failed tests';
 296 is_deeply [ $parser->failed ], [4], '... and get a list of the failed tests';
 297
 298 can_ok $parser, 'actual_passed';
 299 is $parser->actual_passed, 4,
 300   '... and we should have the correct number of actually passed tests';
 301 is_deeply [ $parser->actual_passed ], [ 1, 3, 5, 6 ],
 302   '... and get a list of the actually passed tests';
 303
 304 can_ok $parser, 'actual_failed';
 305 is $parser->actual_failed, 3,
 306   '... and the correct number of actually failed tests';
 307 is_deeply [ $parser->actual_failed ], [ 2, 4, 7 ],
 308   '... or get a list of the actually failed tests';
 309
 310 can_ok $parser, 'todo';
 311 is $parser->todo, 3,
 312   '... and we should have the correct number of TODO tests';
 313 is_deeply [ $parser->todo ], [ 2, 6, 7 ],
 314   '... and get a list of the TODO tests';
 315
 316 can_ok $parser, 'skipped';
 317 is $parser->skipped, 1,
 318   '... and we should have the correct number of skipped tests';
 319 is_deeply [ $parser->skipped ], [5],
 320   '... and get a list of the skipped tests';
 321
 322 # check the plan
 323
 324 can_ok $parser, 'plan';
 325 is $parser->plan,          '1..7', '... and we should have the correct plan';
 326 is $parser->tests_planned, 7,      '... and the correct number of tests';
 327
 328 # "Unexpectedly succeeded"
 329 can_ok $parser, 'todo_passed';
 330 is scalar $parser->todo_passed, 1,
 331   '... and it should report the number of tests which unexpectedly succeeded';
 332 is_deeply [ $parser->todo_passed ], [6],
 333   '... or *which* tests unexpectedly succeeded';
 334
 335 #
 336 # Bug report from Torsten Schoenfeld
 337 # Makes sure parser can handle blank lines
 338 #
 339
 340 $tap = <<'END_TAP';
 341 1..2
 342 ok 1 - input file opened
 343
 344
 345 ok 2 - read the rest of the file
 346 END_TAP
 347
 348 my $aref = [ split /\n/ => $tap ];
 349
 350 can_ok $PARSER, 'new';
 351 $parser = $PARSER->new( { stream => TAP::Parser::Iterator->new($aref) } );
 352 isa_ok $parser, $PARSER, '... and calling it should succeed';
 353
 354 # results() is sane?
 355
 356 ok @results = _get_results($parser), 'The parser should return results';
 357 is scalar @results, 5, '... and there should be one for each line';
 358
 359 # check the test plan
 360
 361 $result = shift @results;
 362 isa_ok $result, $PLAN;
 363 can_ok $result, 'type';
 364 is $result->type, 'plan', '... and it should report the correct type';
 365 ok $result->is_plan,   '... and it should identify itself as a plan';
 366 is $result->plan,      '1..2', '... and identify the plan';
 367 is $result->as_string, '1..2',
 368   '... and have the correct string representation';
 369 is $result->raw, '1..2', '... and raw() should return the original line';
 370
 371 # a normal, passing test
 372
 373 $test = shift @results;
 374 isa_ok $test, $TEST;
 375 is $test->type, 'test', '... and it should report the correct type';
 376 ok $test->is_test, '... and it should identify itself as a test';
 377 is $test->ok,      'ok', '... and it should have the correct ok()';
 378 ok $test->is_ok,   '... and the correct boolean version of is_ok()';
 379 ok $test->is_actual_ok,
 380   '... and the correct boolean version of is_actual_ok()';
 381 is $test->number, 1, '... and have the correct test number';
 382 is $test->description, '- input file opened',
 383   '... and the correct description';
 384 ok !$test->directive,   '... and not have a directive';
 385 ok !$test->explanation, '... or a directive explanation';
 386 ok !$test->has_skip,    '... and it is not a SKIPped test';
 387 ok !$test->has_todo,    '... nor a TODO test';
 388 is $test->as_string, 'ok 1 - input file opened',
 389   '... and its string representation should be correct';
 390 is $test->raw, 'ok 1 - input file opened',
 391   '... and raw() should return the original line';
 392
 393 # junk lines should be preserved
 394
 395 $unknown = shift @results;
 396 isa_ok $unknown, $UNKNOWN;
 397 is $unknown->type, 'unknown', '... and it should report the correct type';
 398 ok $unknown->is_unknown, '... and it should identify itself as unknown';
 399 is $unknown->as_string,  '',
 400   '... and its string representation should be returned verbatim';
 401 is $unknown->raw, '', '... and raw() should return the original line';
 402
 403 # ... and the second empty line
 404
 405 $unknown = shift @results;
 406 isa_ok $unknown, $UNKNOWN;
 407 is $unknown->type, 'unknown', '... and it should report the correct type';
 408 ok $unknown->is_unknown, '... and it should identify itself as unknown';
 409 is $unknown->as_string,  '',
 410   '... and its string representation should be returned verbatim';
 411 is $unknown->raw, '', '... and raw() should return the original line';
 412
 413 # a passing test
 414
 415 $test = shift @results;
 416 isa_ok $test, $TEST;
 417 is $test->type, 'test', '... and it should report the correct type';
 418 ok $test->is_test, '... and it should identify itself as a test';
 419 is $test->ok,      'ok', '... and it should have the correct ok()';
 420 ok $test->is_ok,   '... and the correct boolean version of is_ok()';
 421 ok $test->is_actual_ok,
 422   '... and the correct boolean version of is_actual_ok()';
 423 is $test->number, 2, '... and have the correct test number';
 424 is $test->description, '- read the rest of the file',
 425   '... and the correct description';
 426 ok !$test->directive,   '... and not have a directive';
 427 ok !$test->explanation, '... or a directive explanation';
 428 ok !$test->has_skip,    '... and it is not a SKIPped test';
 429 ok !$test->has_todo,    '... nor a TODO test';
 430 is $test->as_string, 'ok 2 - read the rest of the file',
 431   '... and its string representation should be correct';
 432 is $test->raw, 'ok 2 - read the rest of the file',
 433   '... and raw() should return the original line';
 434
 435 is scalar $parser->passed, 2,
 436   'Empty junk lines should not affect the correct number of tests passed';
 437
 438 # coverage tests
 439 {
 440
 441     # calling a TAP::Parser internal method with a 'foreign' class
 442
 443     my $foreigner = bless {}, 'Foreigner';
 444
 445     my @die;
 446
 447     eval {
 448         local $SIG{__DIE__} = sub { push @die, @_ };
 449
 450         TAP::Parser::_stream $foreigner, qw(a b c);
 451     };
 452
 453     unless ( is @die, 1, 'coverage testing for TAP::Parser accessors' ) {
 454         diag " >>> $_ <<<\n" for @die;
 455     }
 456
 457     like pop @die, qr/_stream[(][)] may not be set externally/,
 458       '... and we died with expected message';
 459 }
 460
 461 {
 462
 463     # set a spool to write to
 464     tie local *SPOOL, 'IO::c55Capture';
 465
 466     my $tap = <<'END_TAP';
 467 TAP version 13
 468 1..7
 469 ok 1 - input file opened
 470 ... this is junk
 471 not ok first line of the input valid # todo some data
 472 # this is a comment
 473 ok 3 - read the rest of the file
 474 not ok 4 - this is a real failure
 475   --- YAML!
 476   ...
 477 ok 5 # skip we have no description
 478 ok 6 - you shall not pass! # TODO should have failed
 479 not ok 7 - Gandalf wins.  Game over.  # TODO 'bout time!
 480 END_TAP
 481
 482     {
 483         my $parser = $PARSER->new(
 484             {   tap   => $tap,
 485                 spool => \*SPOOL,
 486             }
 487         );
 488
 489         _get_results($parser);
 490
 491         my @spooled = tied(*SPOOL)->dump();
 492
 493         is @spooled, 24, 'coverage testing for spool attribute of parser';
 494         is join( '', @spooled ), $tap, "spooled tap matches";
 495     }
 496
 497     {
 498         my $parser = $PARSER->new(
 499             {   tap   => $tap,
 500                 spool => \*SPOOL,
 501             }
 502         );
 503
 504         $parser->callback( 'ALL', sub { } );
 505
 506         _get_results($parser);
 507
 508         my @spooled = tied(*SPOOL)->dump();
 509
 510         is @spooled, 24, 'coverage testing for spool attribute of parser';
 511         is join( '', @spooled ), $tap, "spooled tap matches";
 512     }
 513 }
 514
 515 {
 516
 517     # _initialize coverage
 518
 519     my $x = bless [], 'kjsfhkjsdhf';
 520
 521     my @die;
 522
 523     eval {
 524         local $SIG{__DIE__} = sub { push @die, @_ };
 525
 526         $PARSER->new();
 527     };
 528
 529     is @die, 1, 'coverage testing for _initialize';
 530
 531     like pop @die, qr/PANIC:\s+could not determine stream at/,
 532       '...and it failed as expected';
 533
 534     @die = ();
 535
 536     eval {
 537         local $SIG{__DIE__} = sub { push @die, @_ };
 538
 539         $PARSER->new(
 540             {   stream => 'stream',
 541                 tap    => 'tap',
 542                 source => 'source',    # only one of these is allowed
 543             }
 544         );
 545     };
 546
 547     is @die, 1, 'coverage testing for _initialize';
 548
 549     like pop @die,
 550       qr/You may only choose one of 'exec', 'stream', 'tap' or 'source'/,
 551       '...and it failed as expected';
 552 }
 553
 554 {
 555
 556     # coverage of todo_failed
 557
 558     my $tap = <<'END_TAP';
 559 TAP version 13
 560 1..7
 561 ok 1 - input file opened
 562 ... this is junk
 563 not ok first line of the input valid # todo some data
 564 # this is a comment
 565 ok 3 - read the rest of the file
 566 not ok 4 - this is a real failure
 567   --- YAML!
 568   ...
 569 ok 5 # skip we have no description
 570 ok 6 - you shall not pass! # TODO should have failed
 571 not ok 7 - Gandalf wins.  Game over.  # TODO 'bout time!
 572 END_TAP
 573
 574     my $parser = $PARSER->new( { tap => $tap } );
 575
 576     _get_results($parser);
 577
 578     my @warn;
 579
 580     eval {
 581         local $SIG{__WARN__} = sub { push @warn, @_ };
 582
 583         $parser->todo_failed;
 584     };
 585
 586     is @warn, 1, 'coverage testing of todo_failed';
 587
 588     like pop @warn,
 589       qr/"todo_failed" is deprecated.  Please use "todo_passed".  See the docs[.]/,
 590       '..and failed as expected'
 591 }
 592
 593 {
 594
 595     # coverage testing for T::P::_initialize
 596
 597     # coverage of the source argument paths
 598
 599     # ref argument to source
 600
 601     my $parser = TAP::Parser->new( { source => [ split /$/, $tap ] } );
 602
 603     isa_ok $parser, 'TAP::Parser';
 604
 605     isa_ok $parser->_stream, 'TAP::Parser::Iterator::Array';
 606
 607     # uncategorisable argument to source
 608     my @die;
 609
 610     eval {
 611         local $SIG{__DIE__} = sub { push @die, @_ };
 612
 613         $parser = TAP::Parser->new( { source => 'nosuchfile' } );
 614     };
 615
 616     is @die, 1, 'uncategorisable source';
 617
 618     like pop @die, qr/Cannot determine source for nosuchfile/,
 619       '... and we died as expected';
 620 }
 621
 622 {
 623
 624     # coverage test of perl source with switches
 625
 626     my $parser = TAP::Parser->new(
 627         {   source => File::Spec->catfile( ($ENV{PERL_CORE} ? 'lib' : 't'),
 628                                            'sample-tests', 'simple' ),
 629         }
 630     );
 631
 632     isa_ok $parser, 'TAP::Parser';
 633
 634     isa_ok $parser->_stream, 'TAP::Parser::Iterator::Process';
 635
 636     # Workaround for Mac OS X problem wrt closing the iterator without
 637     # reading from it.
 638     $parser->next;
 639 }
 640
 641 {
 642
 643     # coverage testing for TAP::Parser::has_problems
 644
 645     # we're going to need to test lots of fragments of tap
 646     # to cover all the different boolean tests
 647
 648     # currently covered are no problems and failed, so let's next test
 649     # todo_passed
 650
 651     my $tap = <<'END_TAP';
 652 TAP version 13
 653 1..2
 654 ok 1 - input file opened
 655 ok 2 - Gandalf wins.  Game over.  # TODO 'bout time!
 656 END_TAP
 657
 658     my $parser = TAP::Parser->new( { tap => $tap } );
 659
 660     _get_results($parser);
 661
 662     ok !$parser->failed;
 663     ok $parser->todo_passed;
 664
 665     ok !$parser->has_problems, 'and has_problems is false';
 666
 667     # now parse_errors
 668
 669     $tap = <<'END_TAP';
 670 TAP version 13
 671 1..2
 672 SMACK
 673 END_TAP
 674
 675     $parser = TAP::Parser->new( { tap => $tap } );
 676
 677     _get_results($parser);
 678
 679     ok !$parser->failed;
 680     ok !$parser->todo_passed;
 681     ok $parser->parse_errors;
 682
 683     ok $parser->has_problems;
 684
 685     # Now wait and exit are hard to do in an OS platform-independent way, so
 686     # we won't even bother
 687
 688     $tap = <<'END_TAP';
 689 TAP version 13
 690 1..2
 691 ok 1 - input file opened
 692 ok 2 - Gandalf wins
 693 END_TAP
 694
 695     $parser = TAP::Parser->new( { tap => $tap } );
 696
 697     _get_results($parser);
 698
 699     $parser->wait(1);
 700
 701     ok !$parser->failed;
 702     ok !$parser->todo_passed;
 703     ok !$parser->parse_errors;
 704
 705     ok $parser->wait;
 706
 707     ok $parser->has_problems;
 708
 709     # and use the same for exit
 710
 711     $parser->wait(0);
 712     $parser->exit(1);
 713
 714     ok !$parser->failed;
 715     ok !$parser->todo_passed;
 716     ok !$parser->parse_errors;
 717     ok !$parser->wait;
 718
 719     ok $parser->exit;
 720
 721     ok $parser->has_problems;
 722 }
 723
 724 {
 725
 726     # coverage testing of the version states
 727
 728     my $tap = <<'END_TAP';
 729 TAP version 12
 730 1..2
 731 ok 1 - input file opened
 732 ok 2 - Gandalf wins
 733 END_TAP
 734
 735     my $parser = TAP::Parser->new( { tap => $tap } );
 736
 737     _get_results($parser);
 738
 739     my @errors = $parser->parse_errors;
 740
 741     is @errors, 1, 'test too low version number';
 742
 743     like pop @errors,
 744       qr/Explicit TAP version must be at least 13. Got version 12/,
 745       '... and trapped expected version error';
 746
 747     # now too high a version
 748     $tap = <<'END_TAP';
 749 TAP version 14
 750 1..2
 751 ok 1 - input file opened
 752 ok 2 - Gandalf wins
 753 END_TAP
 754
 755     $parser = TAP::Parser->new( { tap => $tap } );
 756
 757     _get_results($parser);
 758
 759     @errors = $parser->parse_errors;
 760
 761     is @errors, 1, 'test too high version number';
 762
 763     like pop @errors,
 764       qr/TAP specified version 14 but we don't know about versions later than 13/,
 765       '... and trapped expected version error';
 766 }
 767
 768 {
 769
 770     # coverage testing of TAP version in the wrong place
 771
 772     my $tap = <<'END_TAP';
 773 1..2
 774 ok 1 - input file opened
 775 TAP version 12
 776 ok 2 - Gandalf wins
 777 END_TAP
 778
 779     my $parser = TAP::Parser->new( { tap => $tap } );
 780
 781     _get_results($parser);
 782
 783     my @errors = $parser->parse_errors;
 784
 785     is @errors, 1, 'test TAP version number in wrong place';
 786
 787     like pop @errors,
 788       qr/If TAP version is present it must be the first line of output/,
 789       '... and trapped expected version error';
 790
 791 }
 792
 793 {
 794
 795     # we're going to bash the internals a bit (but using the API as
 796     # much as possible) to force grammar->tokenise() to fail
 797
 798   # firstly we'll create a stream that dies when its next_raw method is called
 799
 800     package TAP::Parser::Iterator::Dies;
 801
 802     use strict;
 803     use vars qw(@ISA);
 804
 805     @ISA = qw(TAP::Parser::Iterator);
 806
 807     sub new {
 808         return bless {}, shift;
 809     }
 810
 811     sub next_raw {
 812         die 'this is the dying iterator';
 813     }
 814
 815     # required as part of the TPI interface
 816     sub exit { }
 817     sub wait { }
 818
 819     package main;
 820
 821     # now build a standard parser
 822
 823     my $tap = <<'END_TAP';
 824 1..2
 825 ok 1 - input file opened
 826 ok 2 - Gandalf wins
 827 END_TAP
 828
 829     {
 830         my $parser = TAP::Parser->new( { tap => $tap } );
 831
 832         # build a dying stream
 833         my $stream = TAP::Parser::Iterator::Dies->new;
 834
 835         # now replace the stream - we're forced to us an T::P intenal
 836         # method for this
 837         $parser->_stream($stream);
 838
 839         # build a new grammar
 840         my $grammar = TAP::Parser::Grammar->new($stream);
 841
 842         # replace our grammar with this new one
 843         $parser->_grammar($grammar);
 844
 845         # now call next on the parser, and the grammar should die
 846         my $result = $parser->next;    # will die in iterator
 847
 848         is $result, undef, 'iterator dies';
 849
 850         my @errors = $parser->parse_errors;
 851         is @errors, 2, '...and caught expected errrors';
 852
 853         like shift @errors, qr/this is the dying iterator/,
 854           '...and it was what we expected';
 855     }
 856
 857     # Do it all again with callbacks to exercise the other code path in
 858     # the unrolled iterator
 859     {
 860         my $parser = TAP::Parser->new( { tap => $tap } );
 861
 862         $parser->callback( 'ALL', sub { } );
 863
 864         # build a dying stream
 865         my $stream = TAP::Parser::Iterator::Dies->new;
 866
 867         # now replace the stream - we're forced to us an T::P intenal
 868         # method for this
 869         $parser->_stream($stream);
 870
 871         # build a new grammar
 872         my $grammar = TAP::Parser::Grammar->new($stream);
 873
 874         # replace our grammar with this new one
 875         $parser->_grammar($grammar);
 876
 877         # now call next on the parser, and the grammar should die
 878         my $result = $parser->next;    # will die in iterator
 879
 880         is $result, undef, 'iterator dies';
 881
 882         my @errors = $parser->parse_errors;
 883         is @errors, 2, '...and caught expected errrors';
 884
 885         like shift @errors, qr/this is the dying iterator/,
 886           '...and it was what we expected';
 887     }
 888 }
 889
 890 {
 891
 892     # coverage testing of TAP::Parser::_next_state
 893
 894     package TAP::Parser::WithBrokenState;
 895     use vars qw(@ISA);
 896
 897     @ISA = qw( TAP::Parser );
 898
 899     sub _make_state_table {
 900         return { INIT => { plan => { goto => 'FOO' } } };
 901     }
 902
 903     package main;
 904
 905     my $tap = <<'END_TAP';
 906 1..2
 907 ok 1 - input file opened
 908 ok 2 - Gandalf wins
 909 END_TAP
 910
 911     my $parser = TAP::Parser::WithBrokenState->new( { tap => $tap } );
 912
 913     my @die;
 914
 915     eval {
 916         local $SIG{__DIE__} = sub { push @die, @_ };
 917
 918         $parser->next;
 919         $parser->next;
 920     };
 921
 922     is @die, 1, 'detect broken state machine';
 923
 924     like pop @die, qr/Illegal state: FOO/,
 925       '...and the message is as we expect';
 926 }
 927
 928 {
 929
 930     # coverage testing of TAP::Parser::_iter
 931
 932     package TAP::Parser::WithBrokenIter;
 933     use vars qw(@ISA);
 934
 935     @ISA = qw( TAP::Parser );
 936
 937     sub _iter {return}
 938
 939     package main;
 940
 941     my $tap = <<'END_TAP';
 942 1..2
 943 ok 1 - input file opened
 944 ok 2 - Gandalf wins
 945 END_TAP
 946
 947     my $parser = TAP::Parser::WithBrokenIter->new( { tap => $tap } );
 948
 949     my @die;
 950
 951     eval {
 952         local $SIG{__WARN__} = sub { };
 953         local $SIG{__DIE__} = sub { push @die, @_ };
 954
 955         $parser->next;
 956     };
 957
 958     is @die, 1, 'detect broken iter';
 959
 960     like pop @die, qr/Can't use/, '...and the message is as we expect';
 961 }
 962
 963 {
 964
 965     # coverage testing of TAP::Parser::_finish
 966
 967     my $tap = <<'END_TAP';
 968 1..2
 969 ok 1 - input file opened
 970 ok 2 - Gandalf wins
 971 END_TAP
 972
 973     my $parser = TAP::Parser->new( { tap => $tap } );
 974
 975     $parser->tests_run(999);
 976
 977     my @die;
 978
 979     eval {
 980         local $SIG{__DIE__} = sub { push @die, @_ };
 981
 982         _get_results $parser;
 983     };
 984
 985     is @die, 1, 'detect broken test counts';
 986
 987     like pop @die,
 988       qr/Panic: planned test count [(]1001[)] did not equal sum of passed [(]0[)] and failed [(]2[)] tests!/,
 989       '...and the message is as we expect';
 990 }