1#!perl -w
2
3use strict;
4use lib 't/lib';
5
6use Test::More;
7
8use TAP::Parser::YAMLish::Reader;
9
10my @SCHEDULE;
11
12BEGIN {
13    @SCHEDULE = (
14        {   name => 'Hello World',
15            in   => [
16                '--- Hello, World',
17                '...',
18            ],
19            out => "Hello, World",
20        },
21        {   name => 'Hello World 2',
22            in   => [
23                '--- \'Hello, \'\'World\'',
24                '...',
25            ],
26            out => "Hello, 'World",
27        },
28        {   name => 'Hello World 3',
29            in   => [
30                '--- "Hello, World"',
31                '...',
32            ],
33            out => "Hello, World",
34        },
35        {   name => 'Hello World 4',
36            in   => [
37                '--- "Hello, World"',
38                '...',
39            ],
40            out => "Hello, World",
41        },
42        {   name => 'Hello World 4',
43            in   => [
44                '--- >',
45                '   Hello,',
46                '      World',
47                '...',
48            ],
49            out => "Hello, World\n",
50        },
51        {   name => 'Hello World Block',
52            in   => [
53                '--- |',
54                '   Hello,',
55                '      World',
56                '...',
57            ],
58            out => "Hello,\n   World\n",
59        },
60        {   name => 'Hello World 5',
61            in   => [
62                '--- >',
63                '   Hello,',
64                '  World',
65                '...',
66            ],
67            error => qr{Missing\s+'[.][.][.]'},
68        },
69        {   name => 'Simple array',
70            in   => [
71                '---',
72                '- 1',
73                '- 2',
74                '- 3',
75                '...',
76            ],
77            out => [ '1', '2', '3' ],
78        },
79        {   name => 'Mixed array',
80            in   => [
81                '---',
82                '- 1',
83                '- \'two\'',
84                '- "three\n"',
85                '...',
86            ],
87            out => [ '1', 'two', "three\n" ],
88        },
89        {   name => 'Hash in array',
90            in   => [
91                '---',
92                '- 1',
93                '- two: 2',
94                '- 3',
95                '...',
96            ],
97            out => [ '1', { two => '2' }, '3' ],
98        },
99        {   name => 'Hash in array 2',
100            in   => [
101                '---',
102                '- 1',
103                '- two: 2',
104                '  three: 3',
105                '- 4',
106                '...',
107            ],
108            out => [ '1', { two => '2', three => '3' }, '4' ],
109        },
110        {   name => 'Nested array',
111            in   => [
112                '---',
113                '- one',
114                '-',
115                '  - two',
116                '  -',
117                '    - three',
118                '  - four',
119                '- five',
120                '...',
121            ],
122            out => [ 'one', [ 'two', ['three'], 'four' ], 'five' ],
123        },
124        {   name => 'Nested hash',
125            in   => [
126                '---',
127                'one:',
128                '  five: 5',
129                '  two:',
130                '    four: 4',
131                '    three: 3',
132                'six: 6',
133                '...',
134            ],
135            out => {
136                one => { two => { three => '3', four => '4' }, five => '5' },
137                six => '6'
138            },
139        },
140        {   name => 'Space after colon',
141            in   => [ '---', 'spog: ', ' - 1', ' - 2', '...' ],
142            out => { spog => [ 1, 2 ] },
143        },
144        {   name => 'Original YAML::Tiny test',
145            in   => [
146                '---',
147                'invoice: 34843',
148                'date   : 2001-01-23',
149                'bill-to:',
150                '    given  : Chris',
151                '    family : Dumars',
152                '    address:',
153                '        lines: |',
154                '            458 Walkman Dr.',
155                '            Suite #292',
156                '        city    : Royal Oak',
157                '        state   : MI',
158                '        postal  : 48046',
159                'product:',
160                '    - sku         : BL394D',
161                '      quantity    : 4',
162                '      description : Basketball',
163                '      price       : 450.00',
164                '    - sku         : BL4438H',
165                '      quantity    : 1',
166                '      description : Super Hoop',
167                '      price       : 2392.00',
168                'tax  : 251.42',
169                'total: 4443.52',
170                'comments: >',
171                '    Late afternoon is best.',
172                '    Backup contact is Nancy',
173                '    Billsmer @ 338-4338',
174                '...',
175            ],
176            out => {
177                'bill-to' => {
178                    'given'   => 'Chris',
179                    'address' => {
180                        'city'   => 'Royal Oak',
181                        'postal' => '48046',
182                        'lines'  => "458 Walkman Dr.\nSuite #292\n",
183                        'state'  => 'MI'
184                    },
185                    'family' => 'Dumars'
186                },
187                'invoice' => '34843',
188                'date'    => '2001-01-23',
189                'tax'     => '251.42',
190                'product' => [
191                    {   'sku'         => 'BL394D',
192                        'quantity'    => '4',
193                        'price'       => '450.00',
194                        'description' => 'Basketball'
195                    },
196                    {   'sku'         => 'BL4438H',
197                        'quantity'    => '1',
198                        'price'       => '2392.00',
199                        'description' => 'Super Hoop'
200                    }
201                ],
202                'comments' =>
203                  "Late afternoon is best. Backup contact is Nancy Billsmer @ 338-4338\n",
204                'total' => '4443.52'
205            }
206        },
207
208        # Tests harvested from YAML::Tiny
209        {   in    => ['...'],
210            name  => 'Regression: empty',
211            error => qr{document\s+header\s+not\s+found}
212        },
213        {   in => [
214                '# comment',
215                '...'
216            ],
217            name  => 'Regression: only_comment',
218            error => qr{document\s+header\s+not\s+found}
219        },
220        {   out => undef,
221            in  => [
222                '---',
223                '...'
224            ],
225            name  => 'Regression: only_header',
226            error => qr{Premature\s+end}i,
227        },
228        {   out => undef,
229            in  => [
230                '---',
231                '---',
232                '...'
233            ],
234            name  => 'Regression: two_header',
235            error => qr{Unexpected\s+start}i,
236        },
237        {   out => undef,
238            in  => [
239                '--- ~',
240                '...'
241            ],
242            name => 'Regression: one_undef'
243        },
244        {   out => undef,
245            in  => [
246                '---  ~',
247                '...'
248            ],
249            name => 'Regression: one_undef2'
250        },
251        {   in => [
252                '--- ~',
253                '---',
254                '...'
255            ],
256            name  => 'Regression: two_undef',
257            error => qr{Missing\s+'[.][.][.]'},
258        },
259        {   out => 'foo',
260            in  => [
261                '--- foo',
262                '...'
263            ],
264            name => 'Regression: one_scalar',
265        },
266        {   out => 'foo',
267            in  => [
268                '---  foo',
269                '...'
270            ],
271            name => 'Regression: one_scalar2',
272        },
273        {   in => [
274                '--- foo',
275                '--- bar',
276                '...'
277            ],
278            name  => 'Regression: two_scalar',
279            error => qr{Missing\s+'[.][.][.]'},
280        },
281        {   out => ['foo'],
282            in  => [
283                '---',
284                '- foo',
285                '...'
286            ],
287            name => 'Regression: one_list1'
288        },
289        {   out => [
290                'foo',
291                'bar'
292            ],
293            in => [
294                '---',
295                '- foo',
296                '- bar',
297                '...'
298            ],
299            name => 'Regression: one_list2'
300        },
301        {   out => [
302                undef,
303                'bar'
304            ],
305            in => [
306                '---',
307                '- ~',
308                '- bar',
309                '...'
310            ],
311            name => 'Regression: one_listundef'
312        },
313        {   out => { 'foo' => 'bar' },
314            in  => [
315                '---',
316                'foo: bar',
317                '...'
318            ],
319            name => 'Regression: one_hash1'
320        },
321        {   out => {
322                'foo'  => 'bar',
323                'this' => undef
324            },
325            in => [
326                '---',
327                'foo: bar',
328                'this: ~',
329                '...'
330            ],
331            name => 'Regression: one_hash2'
332        },
333        {   out => {
334                'foo' => [
335                    'bar',
336                    undef,
337                    'baz'
338                ]
339            },
340            in => [
341                '---',
342                'foo:',
343                '  - bar',
344                '  - ~',
345                '  - baz',
346                '...'
347            ],
348            name => 'Regression: array_in_hash'
349        },
350        {   out => {
351                'bar' => { 'foo' => 'bar' },
352                'foo' => undef
353            },
354            in => [
355                '---',
356                'foo: ~',
357                'bar:',
358                '  foo: bar',
359                '...'
360            ],
361            name => 'Regression: hash_in_hash'
362        },
363        {   out => [
364                {   'foo'  => undef,
365                    'this' => 'that'
366                },
367                'foo', undef,
368                {   'foo'  => 'bar',
369                    'this' => 'that'
370                }
371            ],
372            in => [
373                '---',
374                '-',
375                '  foo: ~',
376                '  this: that',
377                '- foo',
378                '- ~',
379                '-',
380                '  foo: bar',
381                '  this: that',
382                '...'
383            ],
384            name => 'Regression: hash_in_array'
385        },
386        {   out => ['foo'],
387            in  => [
388                '---',
389                '- \'foo\'',
390                '...'
391            ],
392            name => 'Regression: single_quote1'
393        },
394        {   out => ['  '],
395            in  => [
396                '---',
397                '- \'  \'',
398                '...'
399            ],
400            name => 'Regression: single_spaces'
401        },
402        {   out => [''],
403            in  => [
404                '---',
405                '- \'\'',
406                '...'
407            ],
408            name => 'Regression: single_null'
409        },
410        {   out => '  ',
411            in  => [
412                '--- "  "',
413                '...'
414            ],
415            name => 'Regression: only_spaces'
416        },
417        {   out => [
418                undef,
419                {   'foo'  => 'bar',
420                    'this' => 'that'
421                },
422                'baz'
423            ],
424            in => [
425                '---',
426                '- ~',
427                '- foo: bar',
428                '  this: that',
429                '- baz',
430                '...'
431            ],
432            name => 'Regression: inline_nested_hash'
433        },
434        {   name => "Unprintables",
435            in   => [
436                "---",
437                "- \"\\z\\x01\\x02\\x03\\x04\\x05\\x06\\a\\x08\\t\\n\\v\\f\\r\\x0e\\x0f\"",
438                "- \"\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\e\\x1c\\x1d\\x1e\\x1f\"",
439                "- \" !\\\"#\$%&'()*+,-./\"",
440                "- 0123456789:;<=>?",
441                "- '\@ABCDEFGHIJKLMNO'",
442                "- 'PQRSTUVWXYZ[\\]^_'",
443                "- '`abcdefghijklmno'",
444                "- 'pqrstuvwxyz{|}~\177'",
445                "- \200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217",
446                "- \220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237",
447                "- \240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257",
448                "- \260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277",
449                "- \300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317",
450                "- \320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337",
451                "- \340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357",
452                "- \360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377",
453                "..."
454            ],
455            out => [
456                "\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17",
457                "\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37",
458                " !\"#\$%&'()*+,-./",
459                "0123456789:;<=>?",
460                "\@ABCDEFGHIJKLMNO",
461                "PQRSTUVWXYZ[\\]^_",
462                "`abcdefghijklmno",
463                "pqrstuvwxyz{|}~\177",
464                "\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217",
465                "\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237",
466                "\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257",
467                "\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277",
468                "\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317",
469                "\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337",
470                "\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357",
471                "\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377"
472            ],
473        },
474        {   name => 'Quoted hash keys',
475            in   => [
476                '---',
477                '  "quoted": Magic!',
478                '  "\n\t": newline, tab',
479                '...',
480            ],
481            out => {
482                quoted => 'Magic!',
483                "\n\t" => 'newline, tab',
484            },
485        },
486        {   name => 'Empty',
487            in   => [],
488            out  => undef,
489        },
490    );
491
492    plan tests => @SCHEDULE * 5;
493}
494
495sub iter {
496    my $ar = shift;
497    return sub {
498        return shift @$ar;
499    };
500}
501
502for my $test (@SCHEDULE) {
503    my $name = $test->{name};
504    ok my $yaml = TAP::Parser::YAMLish::Reader->new, "$name: Created";
505    isa_ok $yaml, 'TAP::Parser::YAMLish::Reader';
506
507    my $source = join( "\n", @{ $test->{in} } ) . "\n";
508
509    my $iter = iter( $test->{in} );
510    my $got = eval { $yaml->read($iter) };
511
512    my $raw = $yaml->get_raw;
513
514    if ( my $err = $test->{error} ) {
515        unless ( like $@, $err, "$name: Error message" ) {
516            diag "Error: $@\n";
517        }
518        ok !$got, "$name: No result";
519        pass;
520    }
521    else {
522        my $want = $test->{out};
523        unless ( ok !$@, "$name: No error" ) {
524            diag "Error: $@\n";
525        }
526        is_deeply $got, $want,   "$name: Result matches";
527        is $raw,        $source, "$name: Captured source matches";
528    }
529}
530