9 use Test::More tests => 94;
12 use TAP::Parser::Grammar;
13 use TAP::Parser::Iterator::Array;
15 my $GRAMMAR = 'TAP::Parser::Grammar';
17 # Array based stream that we can push items in to
22 return bless [], $class;
35 sub handle_unicode { }
40 my $parser = EmptyParser->new;
41 can_ok $GRAMMAR, 'new';
42 my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
43 isa_ok $grammar, $GRAMMAR, '... and the object it returns';
45 # Note: all methods are actually class methods. See the docs for the reason
46 # why. We'll still use the instance because that should be forward
49 my @V12 = sort qw(bailout comment plan simple_test test version);
50 my @V13 = sort ( @V12, 'pragma', 'yaml' );
52 can_ok $grammar, 'token_types';
53 ok my @types = sort( $grammar->token_types ),
54 '... and calling it should succeed (v12)';
55 is_deeply \@types, \@V12, '... and return the correct token types (v12)';
57 $grammar->set_version(13);
58 ok @types = sort( $grammar->token_types ),
59 '... and calling it should succeed (v13)';
60 is_deeply \@types, \@V13, '... and return the correct token types (v13)';
62 can_ok $grammar, 'syntax_for';
63 can_ok $grammar, 'handler_for';
65 my ( %syntax_for, %handler_for );
66 foreach my $type (@types) {
67 ok $syntax_for{$type} = $grammar->syntax_for($type),
68 '... and calling syntax_for() with a type name should succeed';
69 cmp_ok ref $syntax_for{$type}, 'eq', 'Regexp',
70 '... and it should return a regex';
72 ok $handler_for{$type} = $grammar->handler_for($type),
73 '... and calling handler_for() with a type name should succeed';
74 cmp_ok ref $handler_for{$type}, 'eq', 'CODE',
75 '... and it should return a code reference';
78 # Test the plan. Gotta have a plan.
80 like $plan, $syntax_for{'plan'}, 'A basic plan should match its syntax';
82 my $method = $handler_for{'plan'};
83 $plan =~ $syntax_for{'plan'};
84 ok my $plan_token = $grammar->$method($plan),
85 '... and the handler should return a token';
95 is_deeply $plan_token, $expected,
96 '... and it should contain the correct data';
98 can_ok $grammar, 'tokenize';
100 ok my $token = $grammar->tokenize,
101 '... and calling it with data should return a token';
102 is_deeply $token, $expected,
103 '... and the token should contain the correct data';
105 # a plan with a skip directive
107 $plan = '1..0 # SKIP why not?';
108 like $plan, $syntax_for{'plan'}, 'a basic plan should match its syntax';
110 $plan =~ $syntax_for{'plan'};
111 ok $plan_token = $grammar->$method($plan),
112 '... and the handler should return a token';
115 'explanation' => 'why not?',
116 'directive' => 'SKIP',
118 'tests_planned' => 0,
119 'raw' => '1..0 # SKIP why not?',
122 is_deeply $plan_token, $expected,
123 '... and it should contain the correct data';
126 ok $token = $grammar->tokenize,
127 '... and calling it with data should return a token';
128 is_deeply $token, $expected,
129 '... and the token should contain the correct data';
134 like $plan, $syntax_for{'plan'},
135 'A plan with an implied "skip all" should match its syntax';
137 $plan =~ $syntax_for{'plan'};
138 ok $plan_token = $grammar->$method($plan),
139 '... and the handler should return a token';
143 'directive' => 'SKIP',
145 'tests_planned' => 0,
149 is_deeply $plan_token, $expected,
150 '... and it should contain the correct data';
153 ok $token = $grammar->tokenize,
154 '... and calling it with data should return a token';
155 is_deeply $token, $expected,
156 '... and the token should contain the correct data';
160 $plan = '1..0 # TODO 3,4,5'; # old syntax. No longer supported
161 unlike $plan, $syntax_for{'plan'},
162 'Bad plans should not match the plan syntax';
166 my $bailout = 'Bail out!';
167 like $bailout, $syntax_for{'bailout'},
168 'Bail out! should match a bailout syntax';
170 $stream->put($bailout);
171 ok $token = $grammar->tokenize,
172 '... and calling it with data should return a token';
178 is_deeply $token, $expected,
179 '... and the token should contain the correct data';
181 $bailout = 'Bail out! some explanation';
182 like $bailout, $syntax_for{'bailout'},
183 'Bail out! should match a bailout syntax';
185 $stream->put($bailout);
186 ok $token = $grammar->tokenize,
187 '... and calling it with data should return a token';
189 'bailout' => 'some explanation',
191 'raw' => 'Bail out! some explanation'
193 is_deeply $token, $expected,
194 '... and the token should contain the correct data';
198 my $comment = '# this is a comment';
199 like $comment, $syntax_for{'comment'},
200 'Comments should match the comment syntax';
202 $stream->put($comment);
203 ok $token = $grammar->tokenize,
204 '... and calling it with data should return a token';
206 'comment' => 'this is a comment',
208 'raw' => '# this is a comment'
210 is_deeply $token, $expected,
211 '... and the token should contain the correct data';
215 my $test = 'ok 1 this is a test';
216 like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
219 ok $token = $grammar->tokenize,
220 '... and calling it with data should return a token';
227 'description' => 'this is a test',
229 'raw' => 'ok 1 this is a test'
231 is_deeply $token, $expected,
232 '... and the token should contain the correct data';
236 $test = 'not ok 2 this is a test # TODO whee!';
237 like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
240 ok $token = $grammar->tokenize,
241 '... and calling it with data should return a token';
245 'explanation' => 'whee!',
247 'directive' => 'TODO',
248 'description' => 'this is a test',
250 'raw' => 'not ok 2 this is a test # TODO whee!'
252 is_deeply $token, $expected, '... and the TODO should be parsed';
256 # escaping that hash mark ('#') means this should *not* be a TODO test
257 $test = 'ok 22 this is a test \# TODO whee!';
258 like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
261 ok $token = $grammar->tokenize,
262 '... and calling it with data should return a token';
269 'description' => 'this is a test \# TODO whee!',
271 'raw' => 'ok 22 this is a test \# TODO whee!'
273 is_deeply $token, $expected,
274 '... and the token should contain the correct data';
278 my $pragma = 'pragma +strict';
279 like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
281 $stream->put($pragma);
282 ok $token = $grammar->tokenize,
283 '... and calling it with data should return a token';
288 'pragmas' => ['+strict'],
291 is_deeply $token, $expected,
292 '... and the token should contain the correct data';
294 $pragma = 'pragma +strict,-foo';
295 like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
297 $stream->put($pragma);
298 ok $token = $grammar->tokenize,
299 '... and calling it with data should return a token';
304 'pragmas' => [ '+strict', '-foo' ],
307 is_deeply $token, $expected,
308 '... and the token should contain the correct data';
310 $pragma = 'pragma +strict , -foo ';
311 like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
313 $stream->put($pragma);
314 ok $token = $grammar->tokenize,
315 '... and calling it with data should return a token';
320 'pragmas' => [ '+strict', '-foo' ],
323 is_deeply $token, $expected,
324 '... and the token should contain the correct data';
334 local $SIG{__DIE__} = sub { push @die, @_ };
336 $grammar->set_version('no_such_version');
339 unless ( is @die, 1, 'set_version with bad version' ) {
340 diag " >>> $_ <<<\n" for @die;
343 like pop @die, qr/^Unsupported syntax version: no_such_version at /,
344 '... and got expected message';
349 my $stream = SS->new;
350 my $parser = EmptyParser->new;
351 my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
357 my $result = $grammar->tokenize();
359 isa_ok $result, 'TAP::Parser::Result::Unknown';
365 my $parser = EmptyParser->new;
366 my $grammar = $GRAMMAR->new( { parser => $parser } );
369 = '1..1 # SKIP with explanation'; # trigger warning in _make_plan_token
371 my $method = $handler_for{'plan'};
373 $plan =~ $syntax_for{'plan'}; # perform regex to populate $1, $2
378 local $SIG{__WARN__} = sub { push @warn, @_ };
380 $grammar->$method($plan);
383 is @warn, 1, 'catch warning on inconsistent plan';
386 qr/^Specified SKIP directive in plan but more than 0 tests [(]1\.\.1 # SKIP with explanation[)]/,
387 '... and its what we expect';
393 my $stream = SS->new;
394 my $parser = EmptyParser->new;
395 my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
397 $grammar->set_version(13);
399 # now this is badly formed YAML that is missing the
400 # leader padding - this is done for coverage testing
401 # the $reader code sub in _make_yaml_token, that is
402 # passed as the yaml consumer to T::P::YAMLish::Reader.
404 # because it isnt valid yaml, the yaml document is
405 # not done, and the _peek in the YAMLish::Reader
406 # code doesnt find the terminating '...' pattern.
407 # but we dont care as this is coverage testing, so
408 # if thats what we have to do to exercise that code,
410 my $yaml = [ ' ... ', '- 2', ' --- ', ];
419 my $iter = iter($yaml);
421 while ( my $line = $iter->() ) {
425 # pad == ' ', marker == '--- '
432 local $SIG{__DIE__} = sub { push @die, @_ };
436 is @die, 1, 'checking badly formed yaml for coverage testing';
438 like pop @die, qr/^Missing '[.][.][.]' at end of YAMLish/,
439 '...and it died like we expect';
444 # coverage testing for TAP::Parser::Iterator::Array
446 my $source = [qw( a b c )];
448 my $aiter = TAP::Parser::Iterator::Array->new($source);
450 my $first = $aiter->next_raw;
452 is $first, 'a', 'access raw iterator';
454 is $aiter->exit, undef, '... and note we didnt exhaust the source';