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