cpan/Filter-Util-Call/t/call.t

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