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