1#!/usr/bin/perl 2 3use strict; 4use lib 't/lib'; 5 6use Test::More; 7 8use TAP::Parser::YAMLish::Reader; 9use TAP::Parser::YAMLish::Writer; 10 11my @SCHEDULE; 12 13BEGIN { 14 @SCHEDULE = ( 15 { name => 'Simple scalar', 16 in => 1, 17 out => [ 18 '--- 1', 19 '...', 20 ], 21 }, 22 { name => 'Undef', 23 in => undef, 24 out => [ 25 '--- ~', 26 '...', 27 ], 28 }, 29 { name => 'Unprintable', 30 in => "\x01\n\t", 31 out => [ 32 '--- "\x01\n\t"', 33 '...', 34 ], 35 }, 36 { name => 'Simple array', 37 in => [ 1, 2, 3 ], 38 out => [ 39 '---', 40 '- 1', 41 '- 2', 42 '- 3', 43 '...', 44 ], 45 }, 46 { name => 'Empty array', 47 in => [], 48 out => [ 49 '--- []', 50 '...' 51 ], 52 }, 53 { name => 'Empty hash', 54 in => {}, 55 out => [ 56 '--- {}', 57 '...' 58 ], 59 }, 60 { name => 'Array, two elements, undef', 61 in => [ undef, undef ], 62 out => [ 63 '---', 64 '- ~', 65 '- ~', 66 '...', 67 ], 68 }, 69 { name => 'Nested array', 70 in => [ 1, 2, [ 3, 4 ], 5 ], 71 out => [ 72 '---', 73 '- 1', 74 '- 2', 75 '-', 76 ' - 3', 77 ' - 4', 78 '- 5', 79 '...', 80 ], 81 }, 82 { name => 'Nested empty', 83 in => [ 1, 2, [], 5 ], 84 out => [ 85 '---', 86 '- 1', 87 '- 2', 88 '- []', 89 '- 5', 90 '...', 91 ], 92 }, 93 { name => 'Simple hash', 94 in => { one => '1', two => '2', three => '3' }, 95 out => [ 96 '---', 97 'one: 1', 98 'three: 3', 99 'two: 2', 100 '...', 101 ], 102 }, 103 { name => 'Nested hash', 104 in => { 105 one => '1', two => '2', 106 more => { three => '3', four => '4' } 107 }, 108 out => [ 109 '---', 110 'more:', 111 ' four: 4', 112 ' three: 3', 113 'one: 1', 114 'two: 2', 115 '...', 116 ], 117 }, 118 { name => 'Nested empty', 119 in => { one => '1', two => '2', more => {} }, 120 out => [ 121 '---', 122 'more: {}', 123 'one: 1', 124 'two: 2', 125 '...', 126 ], 127 }, 128 { name => 'Unprintable key', 129 in => { one => '1', "\x02" => '2', three => '3' }, 130 out => [ 131 '---', 132 '"\x02": 2', 133 'one: 1', 134 'three: 3', 135 '...', 136 ], 137 }, 138 { name => 'Empty key', 139 in => { '' => 'empty' }, 140 out => [ 141 '---', 142 "'': empty", 143 '...', 144 ], 145 }, 146 { name => 'Empty value', 147 in => { '' => '' }, 148 out => [ 149 '---', 150 "'': ''", 151 '...', 152 ], 153 }, 154 { name => 'Funky hash key', 155 in => { './frob' => 'is_frob' }, 156 out => [ 157 '---', 158 '"./frob": is_frob', 159 '...', 160 ] 161 }, 162 { name => 'Complex', 163 in => { 164 'bill-to' => { 165 'given' => 'Chris', 166 'address' => { 167 'city' => 'Royal Oak', 168 'postal' => '48046', 169 'lines' => "458 Walkman Dr.\nSuite #292\n", 170 'state' => 'MI' 171 }, 172 'family' => 'Dumars' 173 }, 174 'invoice' => '34843', 175 'date' => '2001-01-23', 176 'tax' => '251.42', 177 'product' => [ 178 { 'sku' => 'BL394D', 179 'quantity' => '4', 180 'price' => '450.00', 181 'description' => 'Basketball' 182 }, 183 { 'sku' => 'BL4438H', 184 'quantity' => '1', 185 'price' => '2392.00', 186 'description' => 'Super Hoop' 187 } 188 ], 189 'comments' => 190 "Late afternoon is best. Backup contact is Nancy Billsmer @ 338-4338\n", 191 'total' => '4443.52' 192 }, 193 out => [ 194 "---", 195 "bill-to:", 196 " address:", 197 " city: \"Royal Oak\"", 198 " lines: \"458 Walkman Dr.\\nSuite #292\\n\"", 199 " postal: 48046", 200 " state: MI", 201 " family: Dumars", 202 " given: Chris", 203 "comments: \"Late afternoon is best. Backup contact is Nancy Billsmer \@ 338-4338\\n\"", 204 "date: 2001-01-23", 205 "invoice: 34843", 206 "product:", 207 " -", 208 " description: Basketball", 209 " price: 450.00", 210 " quantity: 4", 211 " sku: BL394D", 212 " -", 213 " description: \"Super Hoop\"", 214 " price: 2392.00", 215 " quantity: 1", 216 " sku: BL4438H", 217 "tax: 251.42", 218 "total: 4443.52", 219 "...", 220 ], 221 }, 222 ); 223 224 plan tests => @SCHEDULE * 6; 225} 226 227sub iter { 228 my $ar = shift; 229 return sub { 230 return shift @$ar; 231 }; 232} 233 234for my $test (@SCHEDULE) { 235 my $name = $test->{name}; 236 ok my $yaml = TAP::Parser::YAMLish::Writer->new, "$name: Created"; 237 isa_ok $yaml, 'TAP::Parser::YAMLish::Writer'; 238 239 my $got = []; 240 my $writer = sub { push @$got, shift }; 241 242 my $data = $test->{in}; 243 244 eval { $yaml->write( $data, $writer ) }; 245 246 if ( my $err = $test->{error} ) { 247 unless ( like $@, $err, "$name: Error message" ) { 248 diag "Error: $@\n"; 249 } 250 is_deeply $got, [], "$name: No result"; 251 pass; 252 } 253 else { 254 my $want = $test->{out}; 255 unless ( ok !$@, "$name: No error" ) { 256 diag "Error: $@\n"; 257 } 258 unless ( is_deeply $got, $want, "$name: Result matches" ) { 259 use Data::Dumper; 260 diag Dumper($got); 261 diag Dumper($want); 262 } 263 264 my $yr = TAP::Parser::YAMLish::Reader->new; 265 266 # Now try parsing it 267 my $reader = sub { shift @$got }; 268 my $parsed = eval { $yr->read($reader) }; 269 ok !$@, "$name: no error" or diag "$@"; 270 271 is_deeply $parsed, $data, "$name: Reparse OK"; 272 } 273} 274 275