#!perl -w
use strict;
use warnings;
use lib 't/lib';
use Test::More;
use TAP::Parser::YAMLish::Reader;
my @SCHEDULE;
BEGIN {
@SCHEDULE = (
{ name => 'Hello World',
in => [
'--- Hello, World',
'...',
],
out => "Hello, World",
},
{ name => 'Hello World 2',
in => [
'--- \'Hello, \'\'World\'',
'...',
],
out => "Hello, 'World",
},
{ name => 'Hello World 3',
in => [
'--- "Hello, World"',
'...',
],
out => "Hello, World",
},
{ name => 'Hello World 4',
in => [
'--- "Hello, World"',
'...',
],
out => "Hello, World",
},
{ name => 'Hello World 4',
in => [
'--- >',
' Hello,',
' World',
'...',
],
out => "Hello, World\n",
},
{ name => 'Hello World Block',
in => [
'--- |',
' Hello,',
' World',
'...',
],
out => "Hello,\n World\n",
},
{ name => 'Hello World 5',
in => [
'--- >',
' Hello,',
' World',
'...',
],
error => qr{Missing\s+'[.][.][.]'},
},
{ name => 'Simple array',
in => [
'---',
'- 1',
'- 2',
'- 3',
'...',
],
out => [ '1', '2', '3' ],
},
{ name => 'Mixed array',
in => [
'---',
'- 1',
'- \'two\'',
'- "three\n"',
'...',
],
out => [ '1', 'two', "three\n" ],
},
{ name => 'Hash in array',
in => [
'---',
'- 1',
'- two: 2',
'- 3',
'...',
],
out => [ '1', { two => '2' }, '3' ],
},
{ name => 'Hash in array 2',
in => [
'---',
'- 1',
'- two: 2',
' three: 3',
'- 4',
'...',
],
out => [ '1', { two => '2', three => '3' }, '4' ],
},
{ name => 'Nested array',
in => [
'---',
'- one',
'-',
' - two',
' -',
' - three',
' - four',
'- five',
'...',
],
out => [ 'one', [ 'two', ['three'], 'four' ], 'five' ],
},
{ name => 'Nested hash',
in => [
'---',
'one:',
' five: 5',
' two:',
' four: 4',
' three: 3',
'six: 6',
'...',
],
out => {
one => { two => { three => '3', four => '4' }, five => '5' },
six => '6'
},
},
{ name => 'Space after colon',
in => [ '---', 'spog: ', ' - 1', ' - 2', '...' ],
out => { spog => [ 1, 2 ] },
},
{ name => 'Original YAML::Tiny test',
in => [
'---',
'invoice: 34843',
'date : 2001-01-23',
'bill-to:',
' given : Chris',
' family : Dumars',
' address:',
' lines: |',
' 458 Walkman Dr.',
' Suite #292',
' city : Royal Oak',
' state : MI',
' postal : 48046',
'product:',
' - sku : BL394D',
' quantity : 4',
' description : Basketball',
' price : 450.00',
' - sku : BL4438H',
' quantity : 1',
' description : Super Hoop',
' price : 2392.00',
'tax : 251.42',
'total: 4443.52',
'comments: >',
' Late afternoon is best.',
' Backup contact is Nancy',
' Billsmer @ 338-4338',
'...',
],
out => {
'bill-to' => {
'given' => 'Chris',
'address' => {
'city' => 'Royal Oak',
'postal' => '48046',
'lines' => "458 Walkman Dr.\nSuite #292\n",
'state' => 'MI'
},
'family' => 'Dumars'
},
'invoice' => '34843',
'date' => '2001-01-23',
'tax' => '251.42',
'product' => [
{ 'sku' => 'BL394D',
'quantity' => '4',
'price' => '450.00',
'description' => 'Basketball'
},
{ 'sku' => 'BL4438H',
'quantity' => '1',
'price' => '2392.00',
'description' => 'Super Hoop'
}
],
'comments' =>
"Late afternoon is best. Backup contact is Nancy Billsmer @ 338-4338\n",
'total' => '4443.52'
}
},
# Tests harvested from YAML::Tiny
{ in => ['...'],
name => 'Regression: empty',
error => qr{document\s+header\s+not\s+found}
},
{ in => [
'# comment',
'...'
],
name => 'Regression: only_comment',
error => qr{document\s+header\s+not\s+found}
},
{ out => undef,
in => [
'---',
'...'
],
name => 'Regression: only_header',
error => qr{Premature\s+end}i,
},
{ out => undef,
in => [
'---',
'---',
'...'
],
name => 'Regression: two_header',
error => qr{Unexpected\s+start}i,
},
{ out => undef,
in => [
'--- ~',
'...'
],
name => 'Regression: one_undef'
},
{ out => undef,
in => [
'--- ~',
'...'
],
name => 'Regression: one_undef2'
},
{ in => [
'--- ~',
'---',
'...'
],
name => 'Regression: two_undef',
error => qr{Missing\s+'[.][.][.]'},
},
{ out => 'foo',
in => [
'--- foo',
'...'
],
name => 'Regression: one_scalar',
},
{ out => 'foo',
in => [
'--- foo',
'...'
],
name => 'Regression: one_scalar2',
},
{ in => [
'--- foo',
'--- bar',
'...'
],
name => 'Regression: two_scalar',
error => qr{Missing\s+'[.][.][.]'},
},
{ out => ['foo'],
in => [
'---',
'- foo',
'...'
],
name => 'Regression: one_list1'
},
{ out => [
'foo',
'bar'
],
in => [
'---',
'- foo',
'- bar',
'...'
],
name => 'Regression: one_list2'
},
{ out => [
undef,
'bar'
],
in => [
'---',
'- ~',
'- bar',
'...'
],
name => 'Regression: one_listundef'
},
{ out => { 'foo' => 'bar' },
in => [
'---',
'foo: bar',
'...'
],
name => 'Regression: one_hash1'
},
{ out => {
'foo' => 'bar',
'this' => undef
},
in => [
'---',
'foo: bar',
'this: ~',
'...'
],
name => 'Regression: one_hash2'
},
{ out => {
'foo' => [
'bar',
undef,
'baz'
]
},
in => [
'---',
'foo:',
' - bar',
' - ~',
' - baz',
'...'
],
name => 'Regression: array_in_hash'
},
{ out => {
'bar' => { 'foo' => 'bar' },
'foo' => undef
},
in => [
'---',
'foo: ~',
'bar:',
' foo: bar',
'...'
],
name => 'Regression: hash_in_hash'
},
{ out => [
{ 'foo' => undef,
'this' => 'that'
},
'foo', undef,
{ 'foo' => 'bar',
'this' => 'that'
}
],
in => [
'---',
'-',
' foo: ~',
' this: that',
'- foo',
'- ~',
'-',
' foo: bar',
' this: that',
'...'
],
name => 'Regression: hash_in_array'
},
{ out => ['foo'],
in => [
'---',
'- \'foo\'',
'...'
],
name => 'Regression: single_quote1'
},
{ out => [' '],
in => [
'---',
'- \' \'',
'...'
],
name => 'Regression: single_spaces'
},
{ out => [''],
in => [
'---',
'- \'\'',
'...'
],
name => 'Regression: single_null'
},
{ out => ' ',
in => [
'--- " "',
'...'
],
name => 'Regression: only_spaces'
},
{ out => [
undef,
{ 'foo' => 'bar',
'this' => 'that'
},
'baz'
],
in => [
'---',
'- ~',
'- foo: bar',
' this: that',
'- baz',
'...'
],
name => 'Regression: inline_nested_hash'
},
{ name => "Unprintables",
in => [
"---",
"- \"\\z\\x01\\x02\\x03\\x04\\x05\\x06\\a\\x08\\t\\n\\v\\f\\r\\x0e\\x0f\"",
"- \"\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\e\\x1c\\x1d\\x1e\\x1f\"",
"- \" !\\\"#\$%&'()*+,-./\"",
"- 0123456789:;<=>?",
"- '\@ABCDEFGHIJKLMNO'",
"- 'PQRSTUVWXYZ[\\]^_'",
"- '`abcdefghijklmno'",
"- 'pqrstuvwxyz{|}~\177'",
"- \200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217",
"- \220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237",
"- \240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257",
"- \260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277",
"- \300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317",
"- \320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337",
"- \340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357",
"- \360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377",
"..."
],
out => [
"\0\1\2\3\4\5\6\a\b\t\n\13\f\r\16\17",
"\20\21\22\23\24\25\26\27\30\31\32\e\34\35\36\37",
" !\"#\$%&'()*+,-./",
"0123456789:;<=>?",
"\@ABCDEFGHIJKLMNO",
"PQRSTUVWXYZ[\\]^_",
"`abcdefghijklmno",
"pqrstuvwxyz{|}~\177",
"\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217",
"\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237",
"\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257",
"\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277",
"\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317",
"\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337",
"\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357",
"\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377"
],
},
{ name => 'Quoted hash keys',
in => [
'---',
' "quoted": Magic!',
' "\n\t": newline, tab',
'...',
],
out => {
quoted => 'Magic!',
"\n\t" => 'newline, tab',
},
},
{ name => 'Empty',
in => [],
out => undef,
},
);
plan tests => @SCHEDULE * 5;
}
sub iter {
my $ar = shift;
return sub {
return shift @$ar;
};
}
for my $test (@SCHEDULE) {
my $name = $test->{name};
ok my $yaml = TAP::Parser::YAMLish::Reader->new, "$name: Created";
isa_ok $yaml, 'TAP::Parser::YAMLish::Reader';
my $source = join( "\n", @{ $test->{in} } ) . "\n";
my $iter = iter( $test->{in} );
my $got = eval { $yaml->read($iter) };
my $raw = $yaml->get_raw;
if ( my $err = $test->{error} ) {
unless ( like $@, $err, "$name: Error message" ) {
diag "Error: $@\n";
}
ok !$got, "$name: No result";
pass;
}
else {
my $want = $test->{out};
unless ( ok !$@, "$name: No error" ) {
diag "Error: $@\n";
}
is_deeply $got, $want, "$name: Result matches";
is $raw, $source, "$name: Captured source matches";
}
}