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