6 use Test::More tests => 94;
9 use TAP::Parser::Grammar;
10 use TAP::Parser::Iterator::Array;
12 my $GRAMMAR = 'TAP::Parser::Grammar';
14 # Array based stream that we can push items in to
19 return bless [], $class;
32 sub handle_unicode { }
37 my $parser = EmptyParser->new;
38 can_ok $GRAMMAR, 'new';
39 my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
40 isa_ok $grammar, $GRAMMAR, '... and the object it returns';
42 # Note: all methods are actually class methods. See the docs for the reason
43 # why. We'll still use the instance because that should be forward
46 my @V12 = sort qw(bailout comment plan simple_test test version);
47 my @V13 = sort ( @V12, 'pragma', 'yaml' );
49 can_ok $grammar, 'token_types';
50 ok my @types = sort( $grammar->token_types ),
51 '... and calling it should succeed (v12)';
52 is_deeply \@types, \@V12, '... and return the correct token types (v12)';
54 $grammar->set_version(13);
55 ok @types = sort( $grammar->token_types ),
56 '... and calling it should succeed (v13)';
57 is_deeply \@types, \@V13, '... and return the correct token types (v13)';
59 can_ok $grammar, 'syntax_for';
60 can_ok $grammar, 'handler_for';
62 my ( %syntax_for, %handler_for );
63 foreach my $type (@types) {
64 ok $syntax_for{$type} = $grammar->syntax_for($type),
65 '... and calling syntax_for() with a type name should succeed';
66 cmp_ok ref $syntax_for{$type}, 'eq', 'Regexp',
67 '... and it should return a regex';
69 ok $handler_for{$type} = $grammar->handler_for($type),
70 '... and calling handler_for() with a type name should succeed';
71 cmp_ok ref $handler_for{$type}, 'eq', 'CODE',
72 '... and it should return a code reference';
75 # Test the plan. Gotta have a plan.
77 like $plan, $syntax_for{'plan'}, 'A basic plan should match its syntax';
79 my $method = $handler_for{'plan'};
80 $plan =~ $syntax_for{'plan'};
81 ok my $plan_token = $grammar->$method($plan),
82 '... and the handler should return a token';
92 is_deeply $plan_token, $expected,
93 '... and it should contain the correct data';
95 can_ok $grammar, 'tokenize';
97 ok my $token = $grammar->tokenize,
98 '... and calling it with data should return a token';
99 is_deeply $token, $expected,
100 '... and the token should contain the correct data';
102 # a plan with a skip directive
104 $plan = '1..0 # SKIP why not?';
105 like $plan, $syntax_for{'plan'}, 'a basic plan should match its syntax';
107 $plan =~ $syntax_for{'plan'};
108 ok $plan_token = $grammar->$method($plan),
109 '... and the handler should return a token';
112 'explanation' => 'why not?',
113 'directive' => 'SKIP',
115 'tests_planned' => 0,
116 'raw' => '1..0 # SKIP why not?',
119 is_deeply $plan_token, $expected,
120 '... and it should contain the correct data';
123 ok $token = $grammar->tokenize,
124 '... and calling it with data should return a token';
125 is_deeply $token, $expected,
126 '... and the token should contain the correct data';
131 like $plan, $syntax_for{'plan'},
132 'A plan with an implied "skip all" should match its syntax';
134 $plan =~ $syntax_for{'plan'};
135 ok $plan_token = $grammar->$method($plan),
136 '... and the handler should return a token';
140 'directive' => 'SKIP',
142 'tests_planned' => 0,
146 is_deeply $plan_token, $expected,
147 '... and it should contain the correct data';
150 ok $token = $grammar->tokenize,
151 '... and calling it with data should return a token';
152 is_deeply $token, $expected,
153 '... and the token should contain the correct data';
157 $plan = '1..0 # TODO 3,4,5'; # old syntax. No longer supported
158 unlike $plan, $syntax_for{'plan'},
159 'Bad plans should not match the plan syntax';
163 my $bailout = 'Bail out!';
164 like $bailout, $syntax_for{'bailout'},
165 'Bail out! should match a bailout syntax';
167 $stream->put($bailout);
168 ok $token = $grammar->tokenize,
169 '... and calling it with data should return a token';
175 is_deeply $token, $expected,
176 '... and the token should contain the correct data';
178 $bailout = 'Bail out! some explanation';
179 like $bailout, $syntax_for{'bailout'},
180 'Bail out! should match a bailout syntax';
182 $stream->put($bailout);
183 ok $token = $grammar->tokenize,
184 '... and calling it with data should return a token';
186 'bailout' => 'some explanation',
188 'raw' => 'Bail out! some explanation'
190 is_deeply $token, $expected,
191 '... and the token should contain the correct data';
195 my $comment = '# this is a comment';
196 like $comment, $syntax_for{'comment'},
197 'Comments should match the comment syntax';
199 $stream->put($comment);
200 ok $token = $grammar->tokenize,
201 '... and calling it with data should return a token';
203 'comment' => 'this is a comment',
205 'raw' => '# this is a comment'
207 is_deeply $token, $expected,
208 '... and the token should contain the correct data';
212 my $test = 'ok 1 this is a test';
213 like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
216 ok $token = $grammar->tokenize,
217 '... and calling it with data should return a token';
224 'description' => 'this is a test',
226 'raw' => 'ok 1 this is a test'
228 is_deeply $token, $expected,
229 '... and the token should contain the correct data';
233 $test = 'not ok 2 this is a test # TODO whee!';
234 like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
237 ok $token = $grammar->tokenize,
238 '... and calling it with data should return a token';
242 'explanation' => 'whee!',
244 'directive' => 'TODO',
245 'description' => 'this is a test',
247 'raw' => 'not ok 2 this is a test # TODO whee!'
249 is_deeply $token, $expected, '... and the TODO should be parsed';
253 # escaping that hash mark ('#') means this should *not* be a TODO test
254 $test = 'ok 22 this is a test \# TODO whee!';
255 like $test, $syntax_for{'test'}, 'Tests should match the test syntax';
258 ok $token = $grammar->tokenize,
259 '... and calling it with data should return a token';
266 'description' => 'this is a test \# TODO whee!',
268 'raw' => 'ok 22 this is a test \# TODO whee!'
270 is_deeply $token, $expected,
271 '... and the token should contain the correct data';
275 my $pragma = 'pragma +strict';
276 like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
278 $stream->put($pragma);
279 ok $token = $grammar->tokenize,
280 '... and calling it with data should return a token';
285 'pragmas' => ['+strict'],
288 is_deeply $token, $expected,
289 '... and the token should contain the correct data';
291 $pragma = 'pragma +strict,-foo';
292 like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
294 $stream->put($pragma);
295 ok $token = $grammar->tokenize,
296 '... and calling it with data should return a token';
301 'pragmas' => [ '+strict', '-foo' ],
304 is_deeply $token, $expected,
305 '... and the token should contain the correct data';
307 $pragma = 'pragma +strict , -foo ';
308 like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax';
310 $stream->put($pragma);
311 ok $token = $grammar->tokenize,
312 '... and calling it with data should return a token';
317 'pragmas' => [ '+strict', '-foo' ],
320 is_deeply $token, $expected,
321 '... and the token should contain the correct data';
331 local $SIG{__DIE__} = sub { push @die, @_ };
333 $grammar->set_version('no_such_version');
336 unless ( is @die, 1, 'set_version with bad version' ) {
337 diag " >>> $_ <<<\n" for @die;
340 like pop @die, qr/^Unsupported syntax version: no_such_version at /,
341 '... and got expected message';
346 my $stream = SS->new;
347 my $parser = EmptyParser->new;
348 my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
354 my $result = $grammar->tokenize();
356 isa_ok $result, 'TAP::Parser::Result::Unknown';
362 my $parser = EmptyParser->new;
363 my $grammar = $GRAMMAR->new( { parser => $parser } );
366 = '1..1 # SKIP with explanation'; # trigger warning in _make_plan_token
368 my $method = $handler_for{'plan'};
370 $plan =~ $syntax_for{'plan'}; # perform regex to populate $1, $2
375 local $SIG{__WARN__} = sub { push @warn, @_ };
377 $grammar->$method($plan);
380 is @warn, 1, 'catch warning on inconsistent plan';
383 qr/^Specified SKIP directive in plan but more than 0 tests [(]1\.\.1 # SKIP with explanation[)]/,
384 '... and its what we expect';
390 my $stream = SS->new;
391 my $parser = EmptyParser->new;
392 my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } );
394 $grammar->set_version(13);
396 # now this is badly formed YAML that is missing the
397 # leader padding - this is done for coverage testing
398 # the $reader code sub in _make_yaml_token, that is
399 # passed as the yaml consumer to T::P::YAMLish::Reader.
401 # because it isnt valid yaml, the yaml document is
402 # not done, and the _peek in the YAMLish::Reader
403 # code doesnt find the terminating '...' pattern.
404 # but we dont care as this is coverage testing, so
405 # if thats what we have to do to exercise that code,
407 my $yaml = [ ' ... ', '- 2', ' --- ', ];
416 my $iter = iter($yaml);
418 while ( my $line = $iter->() ) {
422 # pad == ' ', marker == '--- '
429 local $SIG{__DIE__} = sub { push @die, @_ };
433 is @die, 1, 'checking badly formed yaml for coverage testing';
435 like pop @die, qr/^Missing '[.][.][.]' at end of YAMLish/,
436 '...and it died like we expect';
441 # coverage testing for TAP::Parser::Iterator::Array
443 my $source = [qw( a b c )];
445 my $aiter = TAP::Parser::Iterator::Array->new($source);
447 my $first = $aiter->next_raw;
449 is $first, 'a', 'access raw iterator';
451 is $aiter->exit, undef, '... and note we didnt exhaust the source';