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