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