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";
10 require 'lib/filter-util.pl';
16 use vars qw($Inc $Perl);
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" ;
39 # no filter function in module
40 ###############################
42 writeFile("${module}.pm", <<EOM) ;
45 use Filter::Util::Call ;
47 sub import { filter_add(bless []) }
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"/) ;
56 # no reference parameter in filter_add
57 ######################################
59 writeFile("${module}.pm", <<EOM) ;
62 use Filter::Util::Call ;
64 sub import { filter_add() }
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/) ;
81 # a simple filter, using a closure
84 writeFile("${module}.pm", <<EOM, <<'EOM') ;
88 use Filter::Util::Call ;
95 if (($status = filter_read()) > 0) {
105 writeFile($filename, <<EOM, <<'EOM') ;
112 print "I am $here\n" ;
113 print "some letters ABC\n" ;
116 Alphabetti Spagetti ($y)
121 $a = `$Perl "-I." $Inc $filename 2>&1` ;
122 ok(5, ($? >>8) == 0) ;
126 Alphabetti Spagetti (DEFDEF)
129 # a simple filter, not using a closure
132 writeFile("${module}.pm", <<EOM, <<'EOM') ;
136 use Filter::Util::Call ;
137 sub import { filter_add(bless []) }
144 if (($status = filter_read()) > 0) {
154 writeFile($filename, <<EOM, <<'EOM') ;
161 print "I am $here\n" ;
162 print "some letters ABC\n" ;
165 Alphabetti Spagetti ($y)
170 $a = `$Perl "-I." $Inc $filename 2>&1` ;
171 ok(7, ($? >>8) == 0) ;
175 Alphabetti Spagetti (DEFDEF)
183 writeFile("${module2}.pm", <<EOM, <<'EOM') ;
185 use Filter::Util::Call ;
188 sub import { filter_add(bless []) }
195 if (($status = filter_read()) > 0) {
204 writeFile("${module3}.pm", <<EOM, <<'EOM') ;
206 use Filter::Util::Call ;
209 sub import { filter_add(
215 if (($status = filter_read()) > 0) {
225 writeFile("${module4}.pm", <<EOM) ;
230 print "I'm feeling used!\n" ;
231 print "Fred Joe ABC DEF PQR XYZ\n" ;
232 print "See you Today\n" ;
236 writeFile("${module5}.pm", <<EOM, <<'EOM') ;
238 use Filter::Util::Call ;
241 sub import { filter_add(bless []) }
248 if (($status = filter_read()) > 0) {
257 writeFile($filename, <<EOM, <<'EOM') ;
259 # two filters for this file
266 print "some letters ABCXYZ\n" ;
269 Fred likes Alphabetti Spagetti ($y)
274 writeFile($nested, <<EOM, <<'EOM') ;
278 print "This is another file XYZ\n" ;
285 $a = `$Perl "-I." $Inc $filename 2>&1` ;
286 ok(9, ($? >>8) == 0) ;
287 ok(10, $a eq <<EOM) ;
289 Fred Joe ABC DEF PQR XYZ
291 This is another file XYZ
294 Fred likes Alphabetti Spagetti (DEFDEFPQR)
297 # using the module context (with a closure)
298 ###########################################
301 writeFile("${module2}.pm", <<EOM, <<'EOM') ;
303 use Filter::Util::Call ;
319 if (($status = filter_read()) > 0) {
320 foreach $pattern (@strings)
333 writeFile($filename, <<EOM, <<'EOM') ;
335 use $module2 qw( XYZ KLM) ;
336 use $module2 qw( ABC NMO) ;
339 print "some letters ABCXYZ KLM NMO\n" ;
340 $y = "ABCDEFXYZKLMNMO" ;
342 Alphabetti Spagetti ($y)
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)
356 # using the module context (without a closure)
357 ##############################################
360 writeFile("${module2}.pm", <<EOM, <<'EOM') ;
362 use Filter::Util::Call ;
371 filter_add (bless [@strings])
380 if (($status = filter_read()) > 0) {
381 foreach $pattern (@$self)
392 writeFile($filename, <<EOM, <<'EOM') ;
394 use $module2 qw( XYZ KLM) ;
395 use $module2 qw( ABC NMO) ;
398 print "some letters ABCXYZ KLM NMO\n" ;
399 $y = "ABCDEFXYZKLMNMO" ;
401 Alphabetti Spagetti ($y)
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)
417 writeFile("${module2}.pm", <<EOM, <<'EOM') ;
419 use Filter::Util::Call ;
437 if (($status = filter_read()) > 0) {
440 # and now the second line (it will append)
441 $status = filter_read() ;
451 writeFile($filename, <<EOM, <<'EOM') ;
466 $a = `$Perl "-I." $Inc $filename 2>&1` ;
467 ok(15, ($? >>8) == 0) ;
468 ok(16, $a eq <<EOM) ;
476 writeFile("${block}.pm", <<EOM, <<'EOM') ;
478 use Filter::Util::Call ;
487 filter_add (bless [@strings] )
502 my $string = <<'EOM' ;
503 print "hello mum\n" ;
505 print "Who wants it?\n$x\n" ;
509 writeFile($filename, <<EOM, $string ) ;
513 $a = `$Perl "-I." $Inc $filename 2>&1` ;
514 ok(17, ($? >>8) == 0) ;
515 ok(18, $a eq <<EOM) ;
524 writeFile("${block}.pm", <<EOM, <<'EOM') ;
526 use Filter::Util::Call ;
537 filter_add(bless [@strings] )
544 my ($here) = quotemeta getcwd ;
546 if (($status = filter_read()) > 0) {
555 writeFile($filename, <<EOM, <<'EOM') ;
558 print "We are in DIR\n" ;
561 $a = `$Perl "-I." $Inc $filename 2>&1` ;
562 ok(19, ($? >>8) == 0) ;
563 ok(20, $a eq <<EOM) ;
571 writeFile("${block}.pm", <<EOM, <<'EOM') ;
573 use Filter::Util::Call ;
583 filter_add(bless \$count )
592 if ($status = filter_read()) > 0 ;
595 filter_del() if $$self <= 0 ;
603 writeFile($filename, <<EOM, <<'EOM') ;
609 HERE today gone tomorrow\n" ;
612 $a = `$Perl "-I." $Inc $filename 2>&1` ;
613 ok(21, ($? >>8) == 0) ;
614 ok(22, $a eq <<EOM) ;
618 HERE today gone tomorrow
625 writeFile("${block}.pm", <<EOM, <<'EOM') ;
627 use Filter::Util::Call ;
635 filter_add(bless [] )
643 if (($status = filter_read_exact(9)) > 0) {
653 writeFile($filenamebin, <<EOM, <<'EOM') ;
659 HERE today gone tomorrow\n" ;
662 $a = `$Perl "-I." $Inc $filenamebin 2>&1` ;
663 ok(23, ($? >>8) == 0) ;
664 ok(24, $a eq <<EOM) ;
668 THERE today gone tomorrow
676 writeFile("${block}.pm", <<EOM, <<'EOM') ;
678 use Filter::Util::Call ;
686 filter_add(bless [] )
694 if (($status = filter_read()) > 0) {
704 writeFile($filename, <<EOM, <<'EOM') ;
713 HERE today gone tomorrow
716 $a = `$Perl "-I." $Inc $filename 2>&1` ;
717 ok(25, ($? >>8) == 0) ;
718 ok(26, $a eq <<EOM) ;
722 HERE today gone tomorrow
732 writeFile("${block}.pm", <<EOM, <<'EOM') ;
734 use Filter::Util::Call ;
742 filter_add(bless [] )
750 if (($status = filter_read()) > 0) {
760 writeFile($filename, <<EOM, <<'EOM') ;
769 HERE today gone tomorrow
772 $a = `$Perl "-I." $Inc $filename 2>&1` ;
773 ok(27, ($? >>8) == 0) ;
774 ok(28, $a eq <<EOM) ;
778 HERE today gone tomorrow
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" ;