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