1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc('../lib'); 7} 8 9plan tests => 80; 10 11my ($OUT, $filename, @chunks, @expected, $msg); 12 13{ 14 # We start with files whose "paragraphs" contain no internal newlines. 15 @chunks = ( 16 join('' => ( 1..3 )), 17 join('' => ( 4..6 )), 18 join('' => ( 7..9 )), 19 10 20 ); 21 22 { 23 $msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 3 final newlines"; 24 25 ($OUT, $filename) = open_tempfile(); 26 print $OUT "$_\n" for ( 27 $chunks[0], 28 ("") x 1, 29 $chunks[1], 30 ("") x 2, 31 $chunks[2], 32 ("") x 3, 33 ); 34 print $OUT $chunks[3]; 35 close $OUT or die; 36 37 @expected = ( 38 "$chunks[0]\n\n", 39 "$chunks[1]\n\n", 40 "$chunks[2]\n\n", 41 $chunks[3], 42 ); 43 local $/ = ''; 44 perform_tests($filename, \@expected, $msg); 45 } 46 47 { 48 $msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 0 final newline"; 49 50 ($OUT, $filename) = open_tempfile(); 51 print $OUT "$_\n" for ( 52 $chunks[0], 53 ("") x 1, 54 $chunks[1], 55 ("") x 2, 56 $chunks[2], 57 ("") x 3, 58 $chunks[3], 59 ); 60 close $OUT or die; 61 62 @expected = ( 63 "$chunks[0]\n\n", 64 "$chunks[1]\n\n", 65 "$chunks[2]\n\n", 66 "$chunks[3]\n", 67 ); 68 local $/ = ''; 69 perform_tests($filename, \@expected, $msg); 70 } 71 72 { 73 $msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 1 final newline"; 74 75 ($OUT, $filename) = open_tempfile(); 76 print $OUT "$_\n" for ( 77 $chunks[0], 78 ("") x 1, 79 $chunks[1], 80 ("") x 2, 81 $chunks[2], 82 ("") x 3, 83 $chunks[3], 84 ("") x 1, 85 ); 86 close $OUT or die; 87 88 @expected = ( 89 "$chunks[0]\n\n", 90 "$chunks[1]\n\n", 91 "$chunks[2]\n\n", 92 "$chunks[3]\n\n", 93 ); 94 local $/ = ''; 95 perform_tests($filename, \@expected, $msg); 96 } 97 98 { 99 $msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 2 final newlines"; 100 101 ($OUT, $filename) = open_tempfile(); 102 print $OUT "$_\n" for ( 103 $chunks[0], 104 ("") x 1, 105 $chunks[1], 106 ("") x 2, 107 $chunks[2], 108 ("") x 3, 109 $chunks[3], 110 ("") x 2, 111 ); 112 close $OUT or die; 113 114 @expected = ( 115 "$chunks[0]\n\n", 116 "$chunks[1]\n\n", 117 "$chunks[2]\n\n", 118 "$chunks[3]\n\n", 119 ); 120 local $/ = ''; 121 perform_tests($filename, \@expected, $msg); 122 } 123} 124 125{ 126 # We continue with files whose "paragraphs" contain internal newlines. 127 @chunks = ( 128 join('' => ( 1, 2, "\n", 3 )), 129 join('' => ( 4, 5, " \n", 6 )), 130 join('' => ( 7, 8, " \t\n", 9 )), 131 10 132 ); 133 134 { 135 $msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 3 final newlines"; 136 137 ($OUT, $filename) = open_tempfile(); 138 print $OUT "$_\n" for ( 139 $chunks[0], 140 ("") x 1, 141 $chunks[1], 142 ("") x 2, 143 $chunks[2], 144 ("") x 3, 145 ); 146 print $OUT $chunks[3]; 147 close $OUT or die; 148 149 @expected = ( 150 "$chunks[0]\n\n", 151 "$chunks[1]\n\n", 152 "$chunks[2]\n\n", 153 $chunks[3], 154 ); 155 local $/ = ''; 156 perform_tests($filename, \@expected, $msg); 157 } 158 159 { 160 $msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 0 final newline"; 161 162 ($OUT, $filename) = open_tempfile(); 163 print $OUT "$_\n" for ( 164 $chunks[0], 165 ("") x 1, 166 $chunks[1], 167 ("") x 2, 168 $chunks[2], 169 ("") x 3, 170 $chunks[3], 171 ); 172 close $OUT or die; 173 174 @expected = ( 175 "$chunks[0]\n\n", 176 "$chunks[1]\n\n", 177 "$chunks[2]\n\n", 178 "$chunks[3]\n", 179 ); 180 local $/ = ''; 181 perform_tests($filename, \@expected, $msg); 182 } 183 184 { 185 $msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 1 final newline"; 186 187 ($OUT, $filename) = open_tempfile(); 188 print $OUT "$_\n" for ( 189 $chunks[0], 190 ("") x 1, 191 $chunks[1], 192 ("") x 2, 193 $chunks[2], 194 ("") x 3, 195 $chunks[3], 196 ("") x 1, 197 ); 198 close $OUT or die; 199 200 @expected = ( 201 "$chunks[0]\n\n", 202 "$chunks[1]\n\n", 203 "$chunks[2]\n\n", 204 "$chunks[3]\n\n", 205 ); 206 local $/ = ''; 207 perform_tests($filename, \@expected, $msg); 208 } 209 210 { 211 $msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 2 final newlines"; 212 213 ($OUT, $filename) = open_tempfile(); 214 print $OUT "$_\n" for ( 215 $chunks[0], 216 ("") x 1, 217 $chunks[1], 218 ("") x 2, 219 $chunks[2], 220 ("") x 3, 221 $chunks[3], 222 ("") x 2, 223 ); 224 close $OUT or die; 225 226 @expected = ( 227 "$chunks[0]\n\n", 228 "$chunks[1]\n\n", 229 "$chunks[2]\n\n", 230 "$chunks[3]\n\n", 231 ); 232 local $/ = ''; 233 perform_tests($filename, \@expected, $msg); 234 } 235} 236 237{ 238 # We continue with files which start with newlines 239 # but whose "paragraphs" contain no internal newlines. 240 # We'll set our expectation that the leading newlines will get trimmed off 241 # and everything else will proceed normally. 242 243 @chunks = ( 244 join('' => ( 1..3 )), 245 join('' => ( 4..6 )), 246 join('' => ( 7..9 )), 247 10 248 ); 249 250 { 251 $msg = "'Badly behaved' file: leading newlines; 3 final newlines"; 252 253 ($OUT, $filename) = open_tempfile(); 254 print $OUT "\n\n\n"; 255 print $OUT "$_\n" for ( 256 $chunks[0], 257 ("") x 1, 258 $chunks[1], 259 ("") x 2, 260 $chunks[2], 261 ("") x 3, 262 ); 263 print $OUT $chunks[3]; 264 close $OUT or die; 265 266 @expected = ( 267 "$chunks[0]\n\n", 268 "$chunks[1]\n\n", 269 "$chunks[2]\n\n", 270 $chunks[3], 271 ); 272 local $/ = ''; 273 perform_tests($filename, \@expected, $msg); 274 } 275 276 { 277 $msg = "'Badly behaved' file: leading newlines; 0 final newline"; 278 279 ($OUT, $filename) = open_tempfile(); 280 print $OUT "\n\n\n"; 281 print $OUT "$_\n" for ( 282 $chunks[0], 283 ("") x 1, 284 $chunks[1], 285 ("") x 2, 286 $chunks[2], 287 ("") x 3, 288 $chunks[3], 289 ); 290 close $OUT or die; 291 292 @expected = ( 293 "$chunks[0]\n\n", 294 "$chunks[1]\n\n", 295 "$chunks[2]\n\n", 296 "$chunks[3]\n", 297 ); 298 local $/ = ''; 299 perform_tests($filename, \@expected, $msg); 300 } 301 302 { 303 $msg = "'Badly behaved' file: leading newlines; 1 final newline"; 304 305 ($OUT, $filename) = open_tempfile(); 306 print $OUT "\n\n\n"; 307 print $OUT "$_\n" for ( 308 $chunks[0], 309 ("") x 1, 310 $chunks[1], 311 ("") x 2, 312 $chunks[2], 313 ("") x 3, 314 $chunks[3], 315 ("") x 1, 316 ); 317 close $OUT or die; 318 319 @expected = ( 320 "$chunks[0]\n\n", 321 "$chunks[1]\n\n", 322 "$chunks[2]\n\n", 323 "$chunks[3]\n\n", 324 ); 325 local $/ = ''; 326 perform_tests($filename, \@expected, $msg); 327 } 328 329 { 330 $msg = "'Badly behaved' file: leading newlines; 2 final newlines"; 331 332 ($OUT, $filename) = open_tempfile(); 333 print $OUT "\n\n\n"; 334 print $OUT "$_\n" for ( 335 $chunks[0], 336 ("") x 1, 337 $chunks[1], 338 ("") x 2, 339 $chunks[2], 340 ("") x 3, 341 $chunks[3], 342 ("") x 2, 343 ); 344 close $OUT or die; 345 346 @expected = ( 347 "$chunks[0]\n\n", 348 "$chunks[1]\n\n", 349 "$chunks[2]\n\n", 350 "$chunks[3]\n\n", 351 ); 352 local $/ = ''; 353 perform_tests($filename, \@expected, $msg); 354 } 355} 356 357{ 358 # We continue with files which start with newlines 359 # and whose "paragraphs" contain internal newlines. 360 # We'll set our expectation that the leading newlines will get trimmed off 361 # and everything else will proceed normally. 362 363 @chunks = ( 364 join('' => ( 1, 2, "\n", 3 )), 365 join('' => ( 4, 5, " \n", 6 )), 366 join('' => ( 7, 8, " \t\n", 9 )), 367 10 368 ); 369 370 { 371 $msg = "'Very badly behaved' file: leading newlines; internal newlines; 3 final newlines"; 372 373 ($OUT, $filename) = open_tempfile(); 374 print $OUT "\n\n\n"; 375 print $OUT "$_\n" for ( 376 $chunks[0], 377 ("") x 1, 378 $chunks[1], 379 ("") x 2, 380 $chunks[2], 381 ("") x 3, 382 ); 383 print $OUT $chunks[3]; 384 close $OUT or die; 385 386 @expected = ( 387 "$chunks[0]\n\n", 388 "$chunks[1]\n\n", 389 "$chunks[2]\n\n", 390 $chunks[3], 391 ); 392 local $/ = ''; 393 perform_tests($filename, \@expected, $msg); 394 } 395 396 { 397 $msg = "'Very badly behaved' file: leading newlines; internal newlines; 0 final newline"; 398 399 ($OUT, $filename) = open_tempfile(); 400 print $OUT "\n\n\n"; 401 print $OUT "$_\n" for ( 402 $chunks[0], 403 ("") x 1, 404 $chunks[1], 405 ("") x 2, 406 $chunks[2], 407 ("") x 3, 408 $chunks[3], 409 ); 410 close $OUT or die; 411 412 @expected = ( 413 "$chunks[0]\n\n", 414 "$chunks[1]\n\n", 415 "$chunks[2]\n\n", 416 "$chunks[3]\n", 417 ); 418 local $/ = ''; 419 perform_tests($filename, \@expected, $msg); 420 } 421 422 { 423 $msg = "'Very badly behaved' file: leading newlines; internal newlines; 1 final newline"; 424 425 ($OUT, $filename) = open_tempfile(); 426 print $OUT "\n\n\n"; 427 print $OUT "$_\n" for ( 428 $chunks[0], 429 ("") x 1, 430 $chunks[1], 431 ("") x 2, 432 $chunks[2], 433 ("") x 3, 434 $chunks[3], 435 ("") x 1, 436 ); 437 close $OUT or die; 438 439 @expected = ( 440 "$chunks[0]\n\n", 441 "$chunks[1]\n\n", 442 "$chunks[2]\n\n", 443 "$chunks[3]\n\n", 444 ); 445 local $/ = ''; 446 perform_tests($filename, \@expected, $msg); 447 } 448 449 { 450 $msg = "'Very badly behaved' file: leading newlines; internal newlines; 2 final newlines"; 451 452 ($OUT, $filename) = open_tempfile(); 453 print $OUT "\n\n\n"; 454 print $OUT "$_\n" for ( 455 $chunks[0], 456 ("") x 1, 457 $chunks[1], 458 ("") x 2, 459 $chunks[2], 460 ("") x 3, 461 $chunks[3], 462 ("") x 2, 463 ); 464 close $OUT or die; 465 466 @expected = ( 467 "$chunks[0]\n\n", 468 "$chunks[1]\n\n", 469 "$chunks[2]\n\n", 470 "$chunks[3]\n\n", 471 ); 472 local $/ = ''; 473 perform_tests($filename, \@expected, $msg); 474 } 475} 476 477########## SUBROUTINES ########## 478 479sub open_tempfile { 480 my $filename = tempfile(); 481 open my $OUT, '>', $filename or die; 482 binmode $OUT; 483 return ($OUT, $filename); 484} 485 486sub perform_tests { 487 my ($filename, $expected, $msg) = @_; 488 open my $IN, '<', $filename or die; 489 my @got = <$IN>; 490 my $success = 1; 491 for (my $i=0; $i<=$#${expected}; $i++) { 492 if ($got[$i] ne $expected->[$i]) { 493 $success = 0; 494 last; 495 } 496 } 497 ok($success, $msg); 498 499 seek $IN, 0, 0; 500 for (my $i=0; $i<=$#${expected}; $i++) { 501 is(<$IN>, $expected->[$i], "Got expected record $i"); 502 } 503 close $IN or die; 504} 505