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