This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Filter-Util-Call from version 1.54 to 1.55
[perl5.git] / 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"/m) ;
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/m) ;
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([])
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