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
CommitLineData
2c4bb738 1BEGIN {
af6a0f9e 2 if ($ENV{PERL_CORE}){
af6a0f9e
PM
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 }
2c4bb738 9 }
2adbc9b6 10 require 'filter-util.pl';
2c4bb738
JH
11}
12
4176d4e4
JH
13use strict;
14use warnings;
15
16use vars qw($Inc $Perl);
17
57a224e5 18print "1..32\n" ;
2c4bb738
JH
19
20$Perl = "$Perl -w" ;
21
22use Cwd ;
4176d4e4 23my $here = getcwd ;
2c4bb738 24
2c4bb738 25
4176d4e4 26my $filename = "call.tst" ;
57a224e5 27my $filename2 = "call2.tst" ;
4176d4e4
JH
28my $filenamebin = "call.bin" ;
29my $module = "MyTest" ;
30my $module2 = "MyTest2" ;
31my $module3 = "MyTest3" ;
32my $module4 = "MyTest4" ;
33my $module5 = "MyTest5" ;
57a224e5 34my $module6 = "MyTest6" ;
4176d4e4
JH
35my $nested = "nested" ;
36my $block = "block" ;
68ae75ab 37my $redir = $^O eq 'MacOS' ? "" : "2>&1";
2c4bb738
JH
38
39# Test error cases
40##################
41
42# no filter function in module
43###############################
44
45writeFile("${module}.pm", <<EOM) ;
46package ${module} ;
47
48use Filter::Util::Call ;
49
50sub import { filter_add(bless []) }
51
521 ;
53EOM
54
68ae75ab
JH
55my $a = `$Perl "-I." $Inc -e "use ${module} ;" $redir` ;
56ok(1, (($? >>8) != 0 or (($^O eq 'MSWin32' || $^O eq 'MacOS' || $^O eq 'NetWare' || $^O eq 'mpeix') && $? != 0))) ;
d8b87a9b 57ok(2, $a =~ /^Can't locate object method "filter" via package "MyTest"/m) ;
2c4bb738
JH
58
59# no reference parameter in filter_add
60######################################
61
62writeFile("${module}.pm", <<EOM) ;
63package ${module} ;
64
65use Filter::Util::Call ;
66
67sub import { filter_add() }
68
691 ;
70EOM
71
68ae75ab
JH
72$a = `$Perl "-I." $Inc -e "use ${module} ;" $redir` ;
73ok(3, (($? >>8) != 0 or (($^O eq 'MSWin32' || $^O eq 'MacOS' || $^O eq 'NetWare' || $^O eq 'mpeix') && $? != 0))) ;
2c4bb738 74#ok(4, $a =~ /^usage: filter_add\(ref\) at ${module}.pm/) ;
d8b87a9b 75ok(4, $a =~ /^Not enough arguments for Filter::Util::Call::filter_add/m) ;
2c4bb738
JH
76
77
78
79
80# non-error cases
81#################
82
83
84# a simple filter, using a closure
85#################
86
87writeFile("${module}.pm", <<EOM, <<'EOM') ;
88package ${module} ;
89
90EOM
91use Filter::Util::Call ;
92sub 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
1051 ;
106EOM
107
108writeFile($filename, <<EOM, <<'EOM') ;
109
110use $module ;
111EOM
112
113use Cwd ;
114$here = getcwd ;
115print "I am $here\n" ;
116print "some letters ABC\n" ;
117$y = "ABCDEF" ;
118print <<EOF ;
119Alphabetti Spagetti ($y)
120EOF
121
122EOM
123
68ae75ab 124$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
125ok(5, ($? >>8) == 0) ;
126ok(6, $a eq <<EOM) ;
127I am $here
128some letters DEF
129Alphabetti Spagetti (DEFDEF)
130EOM
131
132# a simple filter, not using a closure
133#################
134
135writeFile("${module}.pm", <<EOM, <<'EOM') ;
136package ${module} ;
137
138EOM
139use Filter::Util::Call ;
140sub import { filter_add(bless []) }
141
142sub 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
1541 ;
155EOM
156
157writeFile($filename, <<EOM, <<'EOM') ;
158
159use $module ;
160EOM
161
162use Cwd ;
163$here = getcwd ;
164print "I am $here\n" ;
165print "some letters ABC\n" ;
166$y = "ABCDEF" ;
167print <<EOF ;
168Alphabetti Spagetti ($y)
169EOF
170
171EOM
172
68ae75ab 173$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
174ok(7, ($? >>8) == 0) ;
175ok(8, $a eq <<EOM) ;
176I am $here
177some letters DEF
178Alphabetti Spagetti (DEFDEF)
179EOM
180
181
182# nested filters
183################
184
185
186writeFile("${module2}.pm", <<EOM, <<'EOM') ;
187package ${module2} ;
188use Filter::Util::Call ;
189
190EOM
191sub import { filter_add(bless []) }
192
193sub 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
2041 ;
205EOM
206
207writeFile("${module3}.pm", <<EOM, <<'EOM') ;
208package ${module3} ;
209use Filter::Util::Call ;
210
211EOM
212sub 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
2251 ;
226EOM
227
228writeFile("${module4}.pm", <<EOM) ;
229package ${module4} ;
230
231use $module5 ;
232
233print "I'm feeling used!\n" ;
234print "Fred Joe ABC DEF PQR XYZ\n" ;
235print "See you Today\n" ;
2361;
237EOM
238
239writeFile("${module5}.pm", <<EOM, <<'EOM') ;
240package ${module5} ;
241use Filter::Util::Call ;
242
243EOM
244sub import { filter_add(bless []) }
245
246sub 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
2571 ;
258EOM
259
260writeFile($filename, <<EOM, <<'EOM') ;
261
262# two filters for this file
263use $module ;
264use $module2 ;
265require "$nested" ;
266use $module4 ;
267EOM
268
269print "some letters ABCXYZ\n" ;
270$y = "ABCDEFXYZ" ;
271print <<EOF ;
272Fred likes Alphabetti Spagetti ($y)
273EOF
274
275EOM
276
277writeFile($nested, <<EOM, <<'EOM') ;
278use $module3 ;
279EOM
280
281print "This is another file XYZ\n" ;
282print <<EOF ;
283Where is Fred?
284EOF
285
286EOM
287
68ae75ab 288$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
289ok(9, ($? >>8) == 0) ;
290ok(10, $a eq <<EOM) ;
291I'm feeling used!
292Fred Joe ABC DEF PQR XYZ
293See you Tomorrow
294This is another file XYZ
295Where is Joe?
296some letters DEFPQR
297Fred likes Alphabetti Spagetti (DEFDEFPQR)
298EOM
299
300# using the module context (with a closure)
301###########################################
302
303
304writeFile("${module2}.pm", <<EOM, <<'EOM') ;
305package ${module2} ;
306use Filter::Util::Call ;
307
308EOM
309sub 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}
3321 ;
333EOM
334
335
336writeFile($filename, <<EOM, <<'EOM') ;
337
338use $module2 qw( XYZ KLM) ;
339use $module2 qw( ABC NMO) ;
340EOM
341
342print "some letters ABCXYZ KLM NMO\n" ;
343$y = "ABCDEFXYZKLMNMO" ;
344print <<EOF ;
345Alphabetti Spagetti ($y)
346EOF
347
348EOM
349
68ae75ab 350$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
351ok(11, ($? >>8) == 0) ;
352ok(12, $a eq <<EOM) ;
353some letters PQRPQR PQR PQR
354Alphabetti Spagetti (PQRDEFPQRPQRPQR)
355EOM
356
357
358
359# using the module context (without a closure)
360##############################################
361
362
363writeFile("${module2}.pm", <<EOM, <<'EOM') ;
364package ${module2} ;
365use Filter::Util::Call ;
366
367EOM
368sub import
369{
370 my ($type) = shift ;
371 my (@strings) = @_ ;
372
373
374 filter_add (bless [@strings])
375}
376
377sub 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
3911 ;
392EOM
393
394
395writeFile($filename, <<EOM, <<'EOM') ;
396
397use $module2 qw( XYZ KLM) ;
398use $module2 qw( ABC NMO) ;
399EOM
400
401print "some letters ABCXYZ KLM NMO\n" ;
402$y = "ABCDEFXYZKLMNMO" ;
403print <<EOF ;
404Alphabetti Spagetti ($y)
405EOF
406
407EOM
408
68ae75ab 409$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
410ok(13, ($? >>8) == 0) ;
411ok(14, $a eq <<EOM) ;
412some letters PQRPQR PQR PQR
413Alphabetti Spagetti (PQRDEFPQRPQRPQR)
414EOM
415
416# multi line test
417#################
418
419
420writeFile("${module2}.pm", <<EOM, <<'EOM') ;
421package ${module2} ;
422use Filter::Util::Call ;
423
424EOM
425sub import
426{
427 my ($type) = shift ;
428 my (@strings) = @_ ;
429
430
431 filter_add(bless [])
432}
433
434sub 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
4501 ;
451EOM
452
453
454writeFile($filename, <<EOM, <<'EOM') ;
455
456use $module2 ;
457EOM
458print "don't cut me
459in half\n" ;
460print
461<<EOF ;
462appen
463ded
464EO
465F
466
467EOM
468
68ae75ab 469$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
470ok(15, ($? >>8) == 0) ;
471ok(16, $a eq <<EOM) ;
472don't cut me in half
473appended
474EOM
475
476# Block test
477#############
478
479writeFile("${block}.pm", <<EOM, <<'EOM') ;
480package ${block} ;
481use Filter::Util::Call ;
482
483EOM
484sub import
485{
486 my ($type) = shift ;
487 my (@strings) = @_ ;
488
489
490 filter_add (bless [@strings] )
491}
492
493sub filter
494{
495 my ($self) = @_ ;
496 my ($status) ;
497 my ($pattern) ;
498
499 filter_read(20) ;
500}
501
5021 ;
503EOM
504
4176d4e4 505my $string = <<'EOM' ;
2c4bb738
JH
506print "hello mum\n" ;
507$x = 'me ' x 3 ;
508print "Who wants it?\n$x\n" ;
509EOM
510
511
512writeFile($filename, <<EOM, $string ) ;
513use $block ;
514EOM
515
68ae75ab 516$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
517ok(17, ($? >>8) == 0) ;
518ok(18, $a eq <<EOM) ;
519hello mum
520Who wants it?
521me me me
522EOM
523
524# use in the filter
525####################
526
527writeFile("${block}.pm", <<EOM, <<'EOM') ;
528package ${block} ;
529use Filter::Util::Call ;
530
531EOM
532use Cwd ;
533
534sub import
535{
536 my ($type) = shift ;
537 my (@strings) = @_ ;
538
539
540 filter_add(bless [@strings] )
541}
542
543sub filter
544{
545 my ($self) = @_ ;
546 my ($status) ;
1fcbfbda 547 my ($here) = quotemeta getcwd ;
2c4bb738
JH
548
549 if (($status = filter_read()) > 0) {
550 s/DIR/$here/g
551 }
552 $status ;
553}
554
5551 ;
556EOM
557
558writeFile($filename, <<EOM, <<'EOM') ;
559use $block ;
560EOM
561print "We are in DIR\n" ;
562EOM
563
68ae75ab 564$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
565ok(19, ($? >>8) == 0) ;
566ok(20, $a eq <<EOM) ;
567We are in $here
568EOM
569
570
571# filter_del
572#############
573
574writeFile("${block}.pm", <<EOM, <<'EOM') ;
575package ${block} ;
576use Filter::Util::Call ;
577
578EOM
579
580sub import
581{
582 my ($type) = shift ;
583 my ($count) = @_ ;
584
585
586 filter_add(bless \$count )
587}
588
589sub 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
6031 ;
604EOM
605
606writeFile($filename, <<EOM, <<'EOM') ;
607use $block (3) ;
608EOM
609print "
610HERE I am
611I am HERE
612HERE today gone tomorrow\n" ;
613EOM
614
68ae75ab 615$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
616ok(21, ($? >>8) == 0) ;
617ok(22, $a eq <<EOM) ;
618
619THERE I am
620I am THERE
621HERE today gone tomorrow
622EOM
623
624
625# filter_read_exact
626####################
627
628writeFile("${block}.pm", <<EOM, <<'EOM') ;
629package ${block} ;
630use Filter::Util::Call ;
631
632EOM
633
634sub import
635{
636 my ($type) = shift ;
637
638 filter_add(bless [] )
639}
640
641sub 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
6531 ;
654EOM
655
656writeFile($filenamebin, <<EOM, <<'EOM') ;
657use $block ;
658EOM
659print "
660HERE I am
661I'm HERE
662HERE today gone tomorrow\n" ;
663EOM
664
68ae75ab 665$a = `$Perl "-I." $Inc $filenamebin $redir` ;
2c4bb738
JH
666ok(23, ($? >>8) == 0) ;
667ok(24, $a eq <<EOM) ;
668
669HERE I am
670I'm THERE
671THERE today gone tomorrow
672EOM
673
674{
675
676# Check __DATA__
677####################
678
679writeFile("${block}.pm", <<EOM, <<'EOM') ;
680package ${block} ;
681use Filter::Util::Call ;
682
683EOM
684
685sub import
686{
687 my ($type) = shift ;
688
06d39b9e 689 filter_add([])
2c4bb738
JH
690}
691
692sub 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
7041 ;
705EOM
706
707writeFile($filename, <<EOM, <<'EOM') ;
708use $block ;
709EOM
710print "HERE HERE\n";
711@a = <DATA>;
712print @a;
713__DATA__
714HERE I am
715I'm HERE
716HERE today gone tomorrow
717EOM
718
68ae75ab 719$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
720ok(25, ($? >>8) == 0) ;
721ok(26, $a eq <<EOM) ;
722THERE THERE
723HERE I am
724I'm HERE
725HERE today gone tomorrow
726EOM
727
728}
729
730{
731
732# Check __END__
733####################
734
735writeFile("${block}.pm", <<EOM, <<'EOM') ;
736package ${block} ;
737use Filter::Util::Call ;
738
739EOM
740
741sub import
742{
743 my ($type) = shift ;
744
745 filter_add(bless [] )
746}
747
748sub 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
7601 ;
761EOM
762
763writeFile($filename, <<EOM, <<'EOM') ;
764use $block ;
765EOM
766print "HERE HERE\n";
767@a = <DATA>;
768print @a;
769__END__
770HERE I am
771I'm HERE
772HERE today gone tomorrow
773EOM
774
68ae75ab 775$a = `$Perl "-I." $Inc $filename $redir` ;
2c4bb738
JH
776ok(27, ($? >>8) == 0) ;
777ok(28, $a eq <<EOM) ;
778THERE THERE
779HERE I am
780I'm HERE
781HERE today gone tomorrow
782EOM
783
784}
785
57a224e5
SR
786{
787
788# no without use
318b791f 789# see Message-ID: <2002110621.427.A15377@ttul.org>
57a224e5
SR
790####################
791
792writeFile("${module6}.pm", <<EOM);
793package ${module6} ;
794#use Filter::Simple;
795#FILTER {}
796use Filter::Util::Call;
797sub import { filter_add(sub{}) }
798sub unimport { filter_del() }
7991;
800EOM
801
802writeFile($filename2, <<EOM);
803no ${module6} ;
804print "ok";
805EOM
806
63c6dcc1
JH
807my $str = $^O eq 'MacOS' ? "'ok'" : "q{ok}";
808my $a = `$Perl "-I." $Inc -e "no ${module6}; print $str"`;
57a224e5 809ok(29, ($? >>8) == 0);
143a3e5e 810chomp( $a ) if $^O eq 'VMS';
57a224e5
SR
811ok(30, $a eq 'ok');
812
813$a = `$Perl "-I." $Inc $filename2`;
814ok(31, ($? >>8) == 0);
143a3e5e 815chomp( $a ) if $^O eq 'VMS';
57a224e5
SR
816ok(32, $a eq 'ok');
817
818}
819
2c4bb738 820END {
95fa9585 821 1 while unlink $filename ;
57a224e5 822 1 while unlink $filename2 ;
95fa9585
JH
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" ;
57a224e5 829 1 while unlink "${module6}.pm" ;
95fa9585
JH
830 1 while unlink $nested ;
831 1 while unlink "${block}.pm" ;
2c4bb738
JH
832}
833
834