t/lib/filter-util.t

   1 BEGIN {
   2     chdir('t') if -d 't';
   3     @INC = '.';
   4     push @INC, '../lib';
   5     require Config; import Config;
   6     if ($Config{'extensions'} !~ m{\bFilter/Util/Call\b}) {
   7         print "1..0 # Skip: Filter::Util::Call was not built\n";
   8         exit 0;
   9     }
  10     require 'lib/filter-util.pl';
  11 }
  12
  13 print "1..28\n" ;
  14
  15 $Perl = "$Perl -w" ;
  16
  17 use Cwd ;
  18 $here = getcwd ;
  19
  20 use vars qw($Inc $Perl);
  21
  22 $filename = "call.tst" ;
  23 $filenamebin = "call.bin" ;
  24 $module   = "MyTest" ;
  25 $module2  = "MyTest2" ;
  26 $module3  = "MyTest3" ;
  27 $module4  = "MyTest4" ;
  28 $module5  = "MyTest5" ;
  29 $nested   = "nested" ;
  30 $block   = "block" ;
  31
  32 # Test error cases
  33 ##################
  34
  35 # no filter function in module
  36 ###############################
  37
  38 writeFile("${module}.pm", <<EOM) ;
  39 package ${module} ;
  40
  41 use Filter::Util::Call ;
  42
  43 sub import { filter_add(bless []) }
  44
  45 1 ;
  46 EOM
  47
  48 $a = `$Perl "-I." $Inc -e "use ${module} ;"  2>&1` ;
  49 ok(1, (($? >>8) != 0 or ($^O eq 'MSWin32' && $? != 0))) ;
  50 ok(2, $a =~ /^Can't locate object method "filter" via package "MyTest"/) ;
  51
  52 # no reference parameter in filter_add
  53 ######################################
  54
  55 writeFile("${module}.pm", <<EOM) ;
  56 package ${module} ;
  57
  58 use Filter::Util::Call ;
  59
  60 sub import { filter_add() }
  61
  62 1 ;
  63 EOM
  64
  65 $a = `$Perl "-I." $Inc -e "use ${module} ;"  2>&1` ;
  66 ok(3, (($? >>8) != 0 or ($^O eq 'MSWin32' && $? != 0))) ;
  67 #ok(4, $a =~ /^usage: filter_add\(ref\) at ${module}.pm/) ;
  68 ok(4, $a =~ /^Not enough arguments for Filter::Util::Call::filter_add/) ;
  69
  70
  71
  72
  73 # non-error cases
  74 #################
  75
  76
  77 # a simple filter, using a closure
  78 #################
  79
  80 writeFile("${module}.pm", <<EOM, <<'EOM') ;
  81 package ${module} ;
  82
  83 EOM
  84 use Filter::Util::Call ;
  85 sub import {
  86     filter_add(
  87         sub {
  88
  89             my ($status) ;
  90
  91             if (($status = filter_read()) > 0) {
  92                 s/ABC/DEF/g
  93             }
  94             $status ;
  95         } ) ;
  96 }
  97
  98 1 ;
  99 EOM
 100
 101 writeFile($filename, <<EOM, <<'EOM') ;
 102
 103 use $module ;
 104 EOM
 105
 106 use Cwd ;
 107 $here = getcwd ;
 108 print "I am $here\n" ;
 109 print "some letters ABC\n" ;
 110 $y = "ABCDEF" ;
 111 print <<EOF ;
 112 Alphabetti Spagetti ($y)
 113 EOF
 114
 115 EOM
 116
 117 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 118 ok(5, ($? >>8) == 0) ;
 119 ok(6, $a eq <<EOM) ;
 120 I am $here
 121 some letters DEF
 122 Alphabetti Spagetti (DEFDEF)
 123 EOM
 124
 125 # a simple filter, not using a closure
 126 #################
 127
 128 writeFile("${module}.pm", <<EOM, <<'EOM') ;
 129 package ${module} ;
 130
 131 EOM
 132 use Filter::Util::Call ;
 133 sub import { filter_add(bless []) }
 134
 135 sub filter
 136 {
 137     my ($self) = @_ ;
 138     my ($status) ;
 139
 140     if (($status = filter_read()) > 0) {
 141         s/ABC/DEF/g
 142     }
 143     $status ;
 144 }
 145
 146
 147 1 ;
 148 EOM
 149
 150 writeFile($filename, <<EOM, <<'EOM') ;
 151
 152 use $module ;
 153 EOM
 154
 155 use Cwd ;
 156 $here = getcwd ;
 157 print "I am $here\n" ;
 158 print "some letters ABC\n" ;
 159 $y = "ABCDEF" ;
 160 print <<EOF ;
 161 Alphabetti Spagetti ($y)
 162 EOF
 163
 164 EOM
 165
 166 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 167 ok(7, ($? >>8) == 0) ;
 168 ok(8, $a eq <<EOM) ;
 169 I am $here
 170 some letters DEF
 171 Alphabetti Spagetti (DEFDEF)
 172 EOM
 173
 174
 175 # nested filters
 176 ################
 177
 178
 179 writeFile("${module2}.pm", <<EOM, <<'EOM') ;
 180 package ${module2} ;
 181 use Filter::Util::Call ;
 182
 183 EOM
 184 sub import { filter_add(bless []) }
 185
 186 sub filter
 187 {
 188     my ($self) = @_ ;
 189     my ($status) ;
 190
 191     if (($status = filter_read()) > 0) {
 192         s/XYZ/PQR/g
 193     }
 194     $status ;
 195 }
 196
 197 1 ;
 198 EOM
 199
 200 writeFile("${module3}.pm", <<EOM, <<'EOM') ;
 201 package ${module3} ;
 202 use Filter::Util::Call ;
 203
 204 EOM
 205 sub import { filter_add(
 206
 207     sub
 208     {
 209         my ($status) ;
 210
 211         if (($status = filter_read()) > 0) {
 212             s/Fred/Joe/g
 213         }
 214         $status ;
 215     } ) ;
 216 }
 217
 218 1 ;
 219 EOM
 220
 221 writeFile("${module4}.pm", <<EOM) ;
 222 package ${module4} ;
 223
 224 use $module5 ;
 225
 226 print "I'm feeling used!\n" ;
 227 print "Fred Joe ABC DEF PQR XYZ\n" ;
 228 print "See you Today\n" ;
 229 1;
 230 EOM
 231
 232 writeFile("${module5}.pm", <<EOM, <<'EOM') ;
 233 package ${module5} ;
 234 use Filter::Util::Call ;
 235
 236 EOM
 237 sub import { filter_add(bless []) }
 238
 239 sub filter
 240 {
 241     my ($self) = @_ ;
 242     my ($status) ;
 243
 244     if (($status = filter_read()) > 0) {
 245         s/Today/Tomorrow/g
 246     }
 247     $status ;
 248 }
 249
 250 1 ;
 251 EOM
 252
 253 writeFile($filename, <<EOM, <<'EOM') ;
 254
 255 # two filters for this file
 256 use $module ;
 257 use $module2 ;
 258 require "$nested" ;
 259 use $module4 ;
 260 EOM
 261
 262 print "some letters ABCXYZ\n" ;
 263 $y = "ABCDEFXYZ" ;
 264 print <<EOF ;
 265 Fred likes Alphabetti Spagetti ($y)
 266 EOF
 267
 268 EOM
 269
 270 writeFile($nested, <<EOM, <<'EOM') ;
 271 use $module3 ;
 272 EOM
 273
 274 print "This is another file XYZ\n" ;
 275 print <<EOF ;
 276 Where is Fred?
 277 EOF
 278
 279 EOM
 280
 281 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 282 ok(9, ($? >>8) == 0) ;
 283 ok(10, $a eq <<EOM) ;
 284 I'm feeling used!
 285 Fred Joe ABC DEF PQR XYZ
 286 See you Tomorrow
 287 This is another file XYZ
 288 Where is Joe?
 289 some letters DEFPQR
 290 Fred likes Alphabetti Spagetti (DEFDEFPQR)
 291 EOM
 292
 293 # using the module context (with a closure)
 294 ###########################################
 295
 296
 297 writeFile("${module2}.pm", <<EOM, <<'EOM') ;
 298 package ${module2} ;
 299 use Filter::Util::Call ;
 300
 301 EOM
 302 sub import
 303 {
 304     my ($type) = shift ;
 305     my (@strings) = @_ ;
 306
 307
 308     filter_add (
 309
 310         sub
 311         {
 312             my ($status) ;
 313             my ($pattern) ;
 314
 315             if (($status = filter_read()) > 0) {
 316                 foreach $pattern (@strings)
 317                     { s/$pattern/PQR/g }
 318             }
 319
 320             $status ;
 321         }
 322         )
 323
 324 }
 325 1 ;
 326 EOM
 327
 328
 329 writeFile($filename, <<EOM, <<'EOM') ;
 330
 331 use $module2 qw( XYZ KLM) ;
 332 use $module2 qw( ABC NMO) ;
 333 EOM
 334
 335 print "some letters ABCXYZ KLM NMO\n" ;
 336 $y = "ABCDEFXYZKLMNMO" ;
 337 print <<EOF ;
 338 Alphabetti Spagetti ($y)
 339 EOF
 340
 341 EOM
 342
 343 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 344 ok(11, ($? >>8) == 0) ;
 345 ok(12, $a eq <<EOM) ;
 346 some letters PQRPQR PQR PQR
 347 Alphabetti Spagetti (PQRDEFPQRPQRPQR)
 348 EOM
 349
 350
 351
 352 # using the module context (without a closure)
 353 ##############################################
 354
 355
 356 writeFile("${module2}.pm", <<EOM, <<'EOM') ;
 357 package ${module2} ;
 358 use Filter::Util::Call ;
 359
 360 EOM
 361 sub import
 362 {
 363     my ($type) = shift ;
 364     my (@strings) = @_ ;
 365
 366
 367     filter_add (bless [@strings])
 368 }
 369
 370 sub filter
 371 {
 372     my ($self) = @_ ;
 373     my ($status) ;
 374     my ($pattern) ;
 375
 376     if (($status = filter_read()) > 0) {
 377         foreach $pattern (@$self)
 378           { s/$pattern/PQR/g }
 379     }
 380
 381     $status ;
 382 }
 383
 384 1 ;
 385 EOM
 386
 387
 388 writeFile($filename, <<EOM, <<'EOM') ;
 389
 390 use $module2 qw( XYZ KLM) ;
 391 use $module2 qw( ABC NMO) ;
 392 EOM
 393
 394 print "some letters ABCXYZ KLM NMO\n" ;
 395 $y = "ABCDEFXYZKLMNMO" ;
 396 print <<EOF ;
 397 Alphabetti Spagetti ($y)
 398 EOF
 399
 400 EOM
 401
 402 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 403 ok(13, ($? >>8) == 0) ;
 404 ok(14, $a eq <<EOM) ;
 405 some letters PQRPQR PQR PQR
 406 Alphabetti Spagetti (PQRDEFPQRPQRPQR)
 407 EOM
 408
 409 # multi line test
 410 #################
 411
 412
 413 writeFile("${module2}.pm", <<EOM, <<'EOM') ;
 414 package ${module2} ;
 415 use Filter::Util::Call ;
 416
 417 EOM
 418 sub import
 419 {
 420     my ($type) = shift ;
 421     my (@strings) = @_ ;
 422
 423
 424     filter_add(bless [])
 425 }
 426
 427 sub filter
 428 {
 429     my ($self) = @_ ;
 430     my ($status) ;
 431
 432     # read first line
 433     if (($status = filter_read()) > 0) {
 434         chop ;
 435         s/\r$//;
 436         # and now the second line (it will append)
 437         $status = filter_read() ;
 438     }
 439
 440     $status ;
 441 }
 442
 443 1 ;
 444 EOM
 445
 446
 447 writeFile($filename, <<EOM, <<'EOM') ;
 448
 449 use $module2  ;
 450 EOM
 451 print "don't cut me
 452 in half\n" ;
 453 print
 454 <<EOF ;
 455 appen
 456 ded
 457 EO
 458 F
 459
 460 EOM
 461
 462 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 463 ok(15, ($? >>8) == 0) ;
 464 ok(16, $a eq <<EOM) ;
 465 don't cut me in half
 466 appended
 467 EOM
 468
 469 # Block test
 470 #############
 471
 472 writeFile("${block}.pm", <<EOM, <<'EOM') ;
 473 package ${block} ;
 474 use Filter::Util::Call ;
 475
 476 EOM
 477 sub import
 478 {
 479     my ($type) = shift ;
 480     my (@strings) = @_ ;
 481
 482
 483     filter_add (bless [@strings] )
 484 }
 485
 486 sub filter
 487 {
 488     my ($self) = @_ ;
 489     my ($status) ;
 490     my ($pattern) ;
 491
 492     filter_read(20)  ;
 493 }
 494
 495 1 ;
 496 EOM
 497
 498 $string = <<'EOM' ;
 499 print "hello mum\n" ;
 500 $x = 'me ' x 3 ;
 501 print "Who wants it?\n$x\n" ;
 502 EOM
 503
 504
 505 writeFile($filename, <<EOM, $string ) ;
 506 use $block ;
 507 EOM
 508
 509 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 510 ok(17, ($? >>8) == 0) ;
 511 ok(18, $a eq <<EOM) ;
 512 hello mum
 513 Who wants it?
 514 me me me
 515 EOM
 516
 517 # use in the filter
 518 ####################
 519
 520 writeFile("${block}.pm", <<EOM, <<'EOM') ;
 521 package ${block} ;
 522 use Filter::Util::Call ;
 523
 524 EOM
 525 use Cwd ;
 526
 527 sub import
 528 {
 529     my ($type) = shift ;
 530     my (@strings) = @_ ;
 531
 532
 533     filter_add(bless [@strings] )
 534 }
 535
 536 sub filter
 537 {
 538     my ($self) = @_ ;
 539     my ($status) ;
 540     my ($here) = quotemeta getcwd ;
 541
 542     if (($status = filter_read()) > 0) {
 543         s/DIR/$here/g
 544     }
 545     $status ;
 546 }
 547
 548 1 ;
 549 EOM
 550
 551 writeFile($filename, <<EOM, <<'EOM') ;
 552 use $block ;
 553 EOM
 554 print "We are in DIR\n" ;
 555 EOM
 556
 557 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 558 ok(19, ($? >>8) == 0) ;
 559 ok(20, $a eq <<EOM) ;
 560 We are in $here
 561 EOM
 562
 563
 564 # filter_del
 565 #############
 566
 567 writeFile("${block}.pm", <<EOM, <<'EOM') ;
 568 package ${block} ;
 569 use Filter::Util::Call ;
 570
 571 EOM
 572
 573 sub import
 574 {
 575     my ($type) = shift ;
 576     my ($count) = @_ ;
 577
 578
 579     filter_add(bless \$count )
 580 }
 581
 582 sub filter
 583 {
 584     my ($self) = @_ ;
 585     my ($status) ;
 586
 587     s/HERE/THERE/g
 588         if ($status = filter_read()) > 0 ;
 589
 590     -- $$self ;
 591     filter_del() if $$self <= 0 ;
 592
 593     $status ;
 594 }
 595
 596 1 ;
 597 EOM
 598
 599 writeFile($filename, <<EOM, <<'EOM') ;
 600 use $block (3) ;
 601 EOM
 602 print "
 603 HERE I am
 604 I am HERE
 605 HERE today gone tomorrow\n" ;
 606 EOM
 607
 608 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 609 ok(21, ($? >>8) == 0) ;
 610 ok(22, $a eq <<EOM) ;
 611
 612 THERE I am
 613 I am THERE
 614 HERE today gone tomorrow
 615 EOM
 616
 617
 618 # filter_read_exact
 619 ####################
 620
 621 writeFile("${block}.pm", <<EOM, <<'EOM') ;
 622 package ${block} ;
 623 use Filter::Util::Call ;
 624
 625 EOM
 626
 627 sub import
 628 {
 629     my ($type) = shift ;
 630
 631     filter_add(bless [] )
 632 }
 633
 634 sub filter
 635 {
 636     my ($self) = @_ ;
 637     my ($status) ;
 638
 639     if (($status = filter_read_exact(9)) > 0) {
 640         s/HERE/THERE/g
 641     }
 642
 643     $status ;
 644 }
 645
 646 1 ;
 647 EOM
 648
 649 writeFile($filenamebin, <<EOM, <<'EOM') ;
 650 use $block ;
 651 EOM
 652 print "
 653 HERE I am
 654 I'm HERE
 655 HERE today gone tomorrow\n" ;
 656 EOM
 657
 658 $a = `$Perl "-I." $Inc $filenamebin  2>&1` ;
 659 ok(23, ($? >>8) == 0) ;
 660 ok(24, $a eq <<EOM) ;
 661
 662 HERE I am
 663 I'm THERE
 664 THERE today gone tomorrow
 665 EOM
 666
 667 {
 668
 669 # Check __DATA__
 670 ####################
 671
 672 writeFile("${block}.pm", <<EOM, <<'EOM') ;
 673 package ${block} ;
 674 use Filter::Util::Call ;
 675
 676 EOM
 677
 678 sub import
 679 {
 680     my ($type) = shift ;
 681
 682     filter_add(bless [] )
 683 }
 684
 685 sub filter
 686 {
 687     my ($self) = @_ ;
 688     my ($status) ;
 689
 690     if (($status = filter_read()) > 0) {
 691         s/HERE/THERE/g
 692     }
 693
 694     $status ;
 695 }
 696
 697 1 ;
 698 EOM
 699
 700 writeFile($filename, <<EOM, <<'EOM') ;
 701 use $block ;
 702 EOM
 703 print "HERE HERE\n";
 704 @a = <DATA>;
 705 print @a;
 706 __DATA__
 707 HERE I am
 708 I'm HERE
 709 HERE today gone tomorrow
 710 EOM
 711
 712 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 713 ok(25, ($? >>8) == 0) ;
 714 ok(26, $a eq <<EOM) ;
 715 THERE THERE
 716 HERE I am
 717 I'm HERE
 718 HERE today gone tomorrow
 719 EOM
 720
 721 }
 722
 723 {
 724
 725 # Check __END__
 726 ####################
 727
 728 writeFile("${block}.pm", <<EOM, <<'EOM') ;
 729 package ${block} ;
 730 use Filter::Util::Call ;
 731
 732 EOM
 733
 734 sub import
 735 {
 736     my ($type) = shift ;
 737
 738     filter_add(bless [] )
 739 }
 740
 741 sub filter
 742 {
 743     my ($self) = @_ ;
 744     my ($status) ;
 745
 746     if (($status = filter_read()) > 0) {
 747         s/HERE/THERE/g
 748     }
 749
 750     $status ;
 751 }
 752
 753 1 ;
 754 EOM
 755
 756 writeFile($filename, <<EOM, <<'EOM') ;
 757 use $block ;
 758 EOM
 759 print "HERE HERE\n";
 760 @a = <DATA>;
 761 print @a;
 762 __END__
 763 HERE I am
 764 I'm HERE
 765 HERE today gone tomorrow
 766 EOM
 767
 768 $a = `$Perl "-I." $Inc $filename  2>&1` ;
 769 ok(27, ($? >>8) == 0) ;
 770 ok(28, $a eq <<EOM) ;
 771 THERE THERE
 772 HERE I am
 773 I'm HERE
 774 HERE today gone tomorrow
 775 EOM
 776
 777 }
 778
 779 END {
 780     1 while unlink $filename ;
 781     1 while unlink $filenamebin ;
 782     1 while unlink "${module}.pm" ;
 783     1 while unlink "${module2}.pm" ;
 784     1 while unlink "${module3}.pm" ;
 785     1 while unlink "${module4}.pm" ;
 786     1 while unlink "${module5}.pm" ;
 787     1 while unlink $nested ;
 788     1 while unlink "${block}.pm" ;
 789 }
 790
 791