ext/Test/Harness/t/grammar.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         unshift @INC, 't/lib';
  12     }
  13 }
  14
  15 use Test::More tests => 94;
  16
  17 use EmptyParser;
  18 use TAP::Parser::Grammar;
  19 use TAP::Parser::Iterator::Array;
  20
  21 my $GRAMMAR = 'TAP::Parser::Grammar';
  22
  23 # Array based stream that we can push items in to
  24 package SS;
  25
  26 sub new {
  27     my $class = shift;
  28     return bless [], $class;
  29 }
  30
  31 sub next {
  32     my $self = shift;
  33     return shift @$self;
  34 }
  35
  36 sub put {
  37     my $self = shift;
  38     unshift @$self, @_;
  39 }
  40
  41 sub handle_unicode { }
  42
  43 package main;
  44
  45 my $stream = SS->new;
  46 my $parser = EmptyParser->new;
  47 can_ok $GRAMMAR, 'new';
  48 my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
  49 isa_ok $grammar, $GRAMMAR, '... and the object it returns';
  50
  51 # Note:  all methods are actually class methods.  See the docs for the reason
  52 # why.  We'll still use the instance because that should be forward
  53 # compatible.
  54
  55 my @V12 = sort qw(bailout comment plan simple_test test version);
  56 my @V13 = sort ( @V12, 'pragma', 'yaml' );
  57
  58 can_ok $grammar, 'token_types';
  59 ok my @types = sort( $grammar->token_types ),
  60   '... and calling it should succeed (v12)';
  61 is_deeply \@types, \@V12, '... and return the correct token types (v12)';
  62
  63 $grammar->set_version(13);
  64 ok @types = sort( $grammar->token_types ),
  65   '... and calling it should succeed (v13)';
  66 is_deeply \@types, \@V13, '... and return the correct token types (v13)';
  67
  68 can_ok $grammar, 'syntax_for';
  69 can_ok $grammar, 'handler_for';
  70
  71 my ( %syntax_for, %handler_for );
  72 foreach my $type (@types) {
  73     ok $syntax_for{$type} = $grammar->syntax_for($type),
  74       '... and calling syntax_for() with a type name should succeed';
  75     cmp_ok ref $syntax_for{$type}, 'eq', 'Regexp',
  76       '... and it should return a regex';
  77
  78     ok $handler_for{$type} = $grammar->handler_for($type),
  79       '... and calling handler_for() with a type name should succeed';
  80     cmp_ok ref $handler_for{$type}, 'eq', 'CODE',
  81       '... and it should return a code reference';
  82 }
  83
  84 # Test the plan.  Gotta have a plan.
  85 my $plan = '1..1';
  86 like $plan, $syntax_for{'plan'}, 'A basic plan should match its syntax';
  87
  88 my $method = $handler_for{'plan'};
  89 $plan =~ $syntax_for{'plan'};
  90 ok my $plan_token = $grammar->$method($plan),
  91   '... and the handler should return a token';
  92
  93 my $expected = {
  94     'explanation'   => '',
  95     'directive'     => '',
  96     'type'          => 'plan',
  97     'tests_planned' => 1,
  98     'raw'           => '1..1',
  99     'todo_list'     => [],
 100 };
 101 is_deeply $plan_token, $expected,
 102   '... and it should contain the correct data';
 103
 104 can_ok $grammar, 'tokenize';
 105 $stream->put($plan);
 106 ok my $token = $grammar->tokenize,
 107   '... and calling it with data should return a token';
 108 is_deeply $token, $expected,
 109   '... and the token should contain the correct data';
 110
 111 # a plan with a skip directive
 112
 113 $plan = '1..0 # SKIP why not?';
 114 like $plan, $syntax_for{'plan'}, 'a basic plan should match its syntax';
 115
 116 $plan =~ $syntax_for{'plan'};
 117 ok $plan_token = $grammar->$method($plan),
 118   '... and the handler should return a token';
 119
 120 $expected = {
 121     'explanation'   => 'why not?',
 122     'directive'     => 'SKIP',
 123     'type'          => 'plan',
 124     'tests_planned' => 0,
 125     'raw'           => '1..0 # SKIP why not?',
 126     'todo_list'     => [],
 127 };
 128 is_deeply $plan_token, $expected,
 129   '... and it should contain the correct data';
 130
 131 $stream->put($plan);
 132 ok $token = $grammar->tokenize,
 133   '... and calling it with data should return a token';
 134 is_deeply $token, $expected,
 135   '... and the token should contain the correct data';
 136
 137 # implied skip
 138
 139 $plan = '1..0';
 140 like $plan, $syntax_for{'plan'},
 141   'A plan  with an implied "skip all" should match its syntax';
 142
 143 $plan =~ $syntax_for{'plan'};
 144 ok $plan_token = $grammar->$method($plan),
 145   '... and the handler should return a token';
 146
 147 $expected = {
 148     'explanation'   => '',
 149     'directive'     => 'SKIP',
 150     'type'          => 'plan',
 151     'tests_planned' => 0,
 152     'raw'           => '1..0',
 153     'todo_list'     => [],
 154 };
 155 is_deeply $plan_token, $expected,
 156   '... and it should contain the correct data';
 157
 158 $stream->put($plan);
 159 ok $token = $grammar->tokenize,
 160   '... and calling it with data should return a token';
 161 is_deeply $token, $expected,
 162   '... and the token should contain the correct data';
 163
 164 # bad plan
 165
 166 $plan = '1..0 # TODO 3,4,5';    # old syntax.  No longer supported
 167 unlike $plan, $syntax_for{'plan'},
 168   'Bad plans should not match the plan syntax';
 169
 170 # Bail out!
 171
 172 my $bailout = 'Bail out!';
 173 like $bailout, $syntax_for{'bailout'},
 174   'Bail out! should match a bailout syntax';
 175
 176 $stream->put($bailout);
 177 ok $token = $grammar->tokenize,
 178   '... and calling it with data should return a token';
 179 $expected = {
 180     'bailout' => '',
 181     'type'    => 'bailout',
 182     'raw'     => 'Bail out!'
 183 };
 184 is_deeply $token, $expected,
 185   '... and the token should contain the correct data';
 186
 187 $bailout = 'Bail out! some explanation';
 188 like $bailout, $syntax_for{'bailout'},
 189   'Bail out! should match a bailout syntax';
 190
 191 $stream->put($bailout);
 192 ok $token = $grammar->tokenize,
 193   '... and calling it with data should return a token';
 194 $expected = {
 195     'bailout' => 'some explanation',
 196     'type'    => 'bailout',
 197     'raw'     => 'Bail out! some explanation'
 198 };
 199 is_deeply $token, $expected,
 200   '... and the token should contain the correct data';
 201
 202 # test comment
 203
 204 my $comment = '# this is a comment';
 205 like $comment, $syntax_for{'comment'},
 206   'Comments should match the comment syntax';
 207
 208 $stream->put($comment);
 209 ok $token = $grammar->tokenize,
 210   '... and calling it with data should return a token';
 211 $expected = {
 212     'comment' => 'this is a comment',
 213     'type'    => 'comment',
 214     'raw'     => '# this is a comment'
 215 };
 216 is_deeply $token, $expected,
 217   '... and the token should contain the correct data';
 218
 219 # test tests :/
 220
 221 my $test = 'ok 1 this is a test';
 222 like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
 223
 224 $stream->put($test);
 225 ok $token = $grammar->tokenize,
 226   '... and calling it with data should return a token';
 227
 228 $expected = {
 229     'ok'          => 'ok',
 230     'explanation' => '',
 231     'type'        => 'test',
 232     'directive'   => '',
 233     'description' => 'this is a test',
 234     'test_num'    => '1',
 235     'raw'         => 'ok 1 this is a test'
 236 };
 237 is_deeply $token, $expected,
 238   '... and the token should contain the correct data';
 239
 240 # TODO tests
 241
 242 $test = 'not ok 2 this is a test # TODO whee!';
 243 like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
 244
 245 $stream->put($test);
 246 ok $token = $grammar->tokenize,
 247   '... and calling it with data should return a token';
 248
 249 $expected = {
 250     'ok'          => 'not ok',
 251     'explanation' => 'whee!',
 252     'type'        => 'test',
 253     'directive'   => 'TODO',
 254     'description' => 'this is a test',
 255     'test_num'    => '2',
 256     'raw'         => 'not ok 2 this is a test # TODO whee!'
 257 };
 258 is_deeply $token, $expected, '... and the TODO should be parsed';
 259
 260 # false TODO tests
 261
 262 # escaping that hash mark ('#') means this should *not* be a TODO test
 263 $test = 'ok 22 this is a test \# TODO whee!';
 264 like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
 265
 266 $stream->put($test);
 267 ok $token = $grammar->tokenize,
 268   '... and calling it with data should return a token';
 269
 270 $expected = {
 271     'ok'          => 'ok',
 272     'explanation' => '',
 273     'type'        => 'test',
 274     'directive'   => '',
 275     'description' => 'this is a test \# TODO whee!',
 276     'test_num'    => '22',
 277     'raw'         => 'ok 22 this is a test \# TODO whee!'
 278 };
 279 is_deeply $token, $expected,
 280   '... and the token should contain the correct data';
 281
 282 # pragmas
 283
 284 my $pragma = 'pragma +strict';
 285 like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
 286
 287 $stream->put($pragma);
 288 ok $token = $grammar->tokenize,
 289   '... and calling it with data should return a token';
 290
 291 $expected = {
 292     'type'    => 'pragma',
 293     'raw'     => $pragma,
 294     'pragmas' => ['+strict'],
 295 };
 296
 297 is_deeply $token, $expected,
 298   '... and the token should contain the correct data';
 299
 300 $pragma = 'pragma +strict,-foo';
 301 like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
 302
 303 $stream->put($pragma);
 304 ok $token = $grammar->tokenize,
 305   '... and calling it with data should return a token';
 306
 307 $expected = {
 308     'type'    => 'pragma',
 309     'raw'     => $pragma,
 310     'pragmas' => [ '+strict', '-foo' ],
 311 };
 312
 313 is_deeply $token, $expected,
 314   '... and the token should contain the correct data';
 315
 316 $pragma = 'pragma  +strict  ,  -foo ';
 317 like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
 318
 319 $stream->put($pragma);
 320 ok $token = $grammar->tokenize,
 321   '... and calling it with data should return a token';
 322
 323 $expected = {
 324     'type'    => 'pragma',
 325     'raw'     => $pragma,
 326     'pragmas' => [ '+strict', '-foo' ],
 327 };
 328
 329 is_deeply $token, $expected,
 330   '... and the token should contain the correct data';
 331
 332 # coverage tests
 333
 334 # set_version
 335
 336 {
 337     my @die;
 338
 339     eval {
 340         local $SIG{__DIE__} = sub { push @die, @_ };
 341
 342         $grammar->set_version('no_such_version');
 343     };
 344
 345     unless ( is @die, 1, 'set_version with bad version' ) {
 346         diag " >>> $_ <<<\n" for @die;
 347     }
 348
 349     like pop @die, qr/^Unsupported syntax version: no_such_version at /,
 350       '... and got expected message';
 351 }
 352
 353 # tokenize
 354 {
 355     my $stream  = SS->new;
 356     my $parser  = EmptyParser->new;
 357     my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
 358
 359     my $plan = '';
 360
 361     $stream->put($plan);
 362
 363     my $result = $grammar->tokenize();
 364
 365     isa_ok $result, 'TAP::Parser::Result::Unknown';
 366 }
 367
 368 # _make_plan_token
 369
 370 {
 371     my $parser = EmptyParser->new;
 372     my $grammar = $GRAMMAR->new( { parser => $parser } );
 373
 374     my $plan
 375       = '1..1 # SKIP with explanation';  # trigger warning in _make_plan_token
 376
 377     my $method = $handler_for{'plan'};
 378
 379     $plan =~ $syntax_for{'plan'};        # perform regex to populate $1, $2
 380
 381     my @warn;
 382
 383     eval {
 384         local $SIG{__WARN__} = sub { push @warn, @_ };
 385
 386         $grammar->$method($plan);
 387     };
 388
 389     is @warn, 1, 'catch warning on inconsistent plan';
 390
 391     like pop @warn,
 392       qr/^Specified SKIP directive in plan but more than 0 tests [(]1\.\.1 # SKIP with explanation[)]/,
 393       '... and its what we expect';
 394 }
 395
 396 # _make_yaml_token
 397
 398 {
 399     my $stream  = SS->new;
 400     my $parser  = EmptyParser->new;
 401     my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
 402
 403     $grammar->set_version(13);
 404
 405     # now this is badly formed YAML that is missing the
 406     # leader padding - this is done for coverage testing
 407     # the $reader code sub in _make_yaml_token, that is
 408     # passed as the yaml consumer to T::P::YAMLish::Reader.
 409
 410     # because it isnt valid yaml, the yaml document is
 411     # not done, and the _peek in the YAMLish::Reader
 412     # code doesnt find the terminating '...' pattern.
 413     # but we dont care as this is coverage testing, so
 414     # if thats what we have to do to exercise that code,
 415     # so be it.
 416     my $yaml = [ '  ...  ', '- 2', '  ---  ', ];
 417
 418     sub iter {
 419         my $ar = shift;
 420         return sub {
 421             return shift @$ar;
 422         };
 423     }
 424
 425     my $iter = iter($yaml);
 426
 427     while ( my $line = $iter->() ) {
 428         $stream->put($line);
 429     }
 430
 431     # pad == '   ', marker == '--- '
 432     # length $pad == 3
 433     # strip == pad
 434
 435     my @die;
 436
 437     eval {
 438         local $SIG{__DIE__} = sub { push @die, @_ };
 439         $grammar->tokenize;
 440     };
 441
 442     is @die, 1, 'checking badly formed yaml for coverage testing';
 443
 444     like pop @die, qr/^Missing '[.][.][.]' at end of YAMLish/,
 445       '...and it died like we expect';
 446 }
 447
 448 {
 449
 450     # coverage testing for TAP::Parser::Iterator::Array
 451
 452     my $source = [qw( a b c )];
 453
 454     my $aiter = TAP::Parser::Iterator::Array->new($source);
 455
 456     my $first = $aiter->next_raw;
 457
 458     is $first, 'a', 'access raw iterator';
 459
 460     is $aiter->exit, undef, '... and note we didnt exhaust the source';
 461 }