Commit | Line | Data |
b965d173 |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
f7c69158 |
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 | } |
b965d173 |
14 | |
2a7f4b9b |
15 | use Test::More tests => 94; |
b965d173 |
16 | |
f7c69158 |
17 | use EmptyParser; |
b965d173 |
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; |
f7c69158 |
46 | my $parser = EmptyParser->new; |
b965d173 |
47 | can_ok $GRAMMAR, 'new'; |
f7c69158 |
48 | my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } ); |
b965d173 |
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 | |
2a7f4b9b |
55 | my @V12 = sort qw(bailout comment plan simple_test test version); |
56 | my @V13 = sort ( @V12, 'pragma', 'yaml' ); |
b965d173 |
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 | |
2a7f4b9b |
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 | |
b965d173 |
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 | |
2a7f4b9b |
345 | unless ( is @die, 1, 'set_version with bad version' ) { |
b965d173 |
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 | { |
f7c69158 |
355 | my $stream = SS->new; |
356 | my $parser = EmptyParser->new; |
357 | my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } ); |
b965d173 |
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 | { |
f7c69158 |
371 | my $parser = EmptyParser->new; |
372 | my $grammar = $GRAMMAR->new( { parser => $parser } ); |
b965d173 |
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 | { |
f7c69158 |
399 | my $stream = SS->new; |
400 | my $parser = EmptyParser->new; |
401 | my $grammar = $GRAMMAR->new( { stream => $stream, parser => $parser } ); |
b965d173 |
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 | } |