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