Commit | Line | Data |
---|---|---|
bde61959 NC |
1 | #!./perl -w |
2 | ||
3 | # Tests for the source filters in coderef-in-@INC | |
4 | ||
5 | BEGIN { | |
6 | chdir 't' if -d 't'; | |
7 | @INC = qw(. ../lib); | |
b4244ddc JH |
8 | if ($ENV{PERL_CORE_MINITEST}) { |
9 | print "1..0 # Skip: no dynamic loading on miniperl\n"; | |
10 | exit 0; | |
11 | } | |
bde61959 NC |
12 | unless (find PerlIO::Layer 'perlio') { |
13 | print "1..0 # Skip: not perlio\n"; | |
14 | exit 0; | |
15 | } | |
16 | require "test.pl"; | |
17 | } | |
18 | use strict; | |
16d5c2f8 | 19 | use Config; |
5675696b | 20 | use Filter::Util::Call; |
bde61959 | 21 | |
34113e50 | 22 | plan(tests => 141); |
bde61959 NC |
23 | |
24 | unshift @INC, sub { | |
25 | no warnings 'uninitialized'; | |
26 | ref $_[1] eq 'ARRAY' ? @{$_[1]} : $_[1]; | |
27 | }; | |
28 | ||
29 | my $fh; | |
30 | ||
31 | open $fh, "<", \'pass("Can return file handles from \@INC");'; | |
5675696b | 32 | do $fh or die; |
bde61959 NC |
33 | |
34 | my @origlines = ("# This is a blank line\n", | |
35 | "pass('Can return generators from \@INC');\n", | |
36 | "pass('Which return multiple lines');\n", | |
37 | "1", | |
38 | ); | |
39 | my @lines = @origlines; | |
40 | sub generator { | |
41 | $_ = shift @lines; | |
42 | # Return of 0 marks EOF | |
43 | return defined $_ ? 1 : 0; | |
44 | }; | |
45 | ||
5675696b | 46 | do \&generator or die; |
bde61959 NC |
47 | |
48 | @lines = @origlines; | |
49 | # Check that the array dereferencing works ready for the more complex tests: | |
5675696b | 50 | do [\&generator] or die; |
bde61959 | 51 | |
34113e50 NC |
52 | sub generator_with_state { |
53 | my $param = $_[1]; | |
54 | is (ref $param, 'ARRAY', "Got our parameter"); | |
55 | $_ = shift @$param; | |
56 | return defined $_ ? 1 : 0; | |
57 | } | |
58 | ||
59 | do [\&generator_with_state, | |
60 | ["pass('Can return generators which take state');\n", | |
61 | "pass('And return multiple lines');\n", | |
62 | ]] or die; | |
bde61959 NC |
63 | |
64 | ||
65 | open $fh, "<", \'fail("File handles and filters work from \@INC");'; | |
66 | ||
bccf3f3d | 67 | do [$fh, sub {s/fail/pass/; return;}] or die; |
bde61959 NC |
68 | |
69 | open $fh, "<", \'fail("File handles and filters with state work from \@INC");'; | |
70 | ||
bccf3f3d | 71 | do [$fh, sub {s/$_[1]/pass/; return;}, 'fail'] or die; |
5675696b NC |
72 | |
73 | print "# 2 tests with pipes from subprocesses.\n"; | |
74 | ||
baf93d00 CB |
75 | my ($echo_command, $pass_arg, $fail_arg); |
76 | ||
77 | if ($^O eq 'VMS') { | |
78 | $echo_command = 'write sys$output'; | |
79 | $pass_arg = '"pass"'; | |
80 | $fail_arg = '"fail"'; | |
81 | } | |
82 | else { | |
83 | $echo_command = 'echo'; | |
84 | $pass_arg = 'pass'; | |
85 | $fail_arg = 'fail'; | |
86 | } | |
87 | ||
88 | open $fh, "$echo_command $pass_arg|" or die $!; | |
5675696b NC |
89 | |
90 | do $fh or die; | |
91 | ||
baf93d00 | 92 | open $fh, "$echo_command $fail_arg|" or die $!; |
5675696b | 93 | |
bccf3f3d | 94 | do [$fh, sub {s/$_[1]/pass/; return;}, 'fail'] or die; |
5675696b NC |
95 | |
96 | sub rot13_filter { | |
97 | filter_add(sub { | |
98 | my $status = filter_read(); | |
99 | tr/A-Za-z/N-ZA-Mn-za-m/; | |
100 | $status; | |
101 | }) | |
102 | } | |
103 | ||
104 | open $fh, "<", \<<'EOC'; | |
105 | BEGIN {rot13_filter}; | |
106 | cnff("This will rot13'ed prepend"); | |
107 | EOC | |
108 | ||
109 | do $fh or die; | |
110 | ||
111 | open $fh, "<", \<<'EOC'; | |
112 | ORTVA {ebg13_svygre}; | |
113 | pass("This will rot13'ed twice"); | |
114 | EOC | |
115 | ||
bccf3f3d | 116 | do [$fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/; return;}] or die; |
5675696b NC |
117 | |
118 | my $count = 32; | |
119 | sub prepend_rot13_filter { | |
120 | filter_add(sub { | |
8498a518 | 121 | my $previous = $_; |
5675696b NC |
122 | # Filters should append to any existing data in $_ |
123 | # But (logically) shouldn't filter it twice. | |
124 | my $test = "fzrt!"; | |
125 | $_ = $test; | |
126 | my $status = filter_read(); | |
5675696b NC |
127 | my $got = substr $_, 0, length $test, ''; |
128 | is $got, $test, "Upstream didn't alter existing data"; | |
129 | tr/A-Za-z/N-ZA-Mn-za-m/; | |
130 | $_ = $previous . $_; | |
131 | die "Looping infinitely" unless $count--; | |
132 | $status; | |
133 | }) | |
134 | } | |
135 | ||
136 | open $fh, "<", \<<'EOC'; | |
137 | ORTVA {cercraq_ebg13_svygre}; | |
138 | pass("This will rot13'ed twice"); | |
139 | EOC | |
140 | ||
bccf3f3d | 141 | do [$fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/; return;}] or die; |
937b367d NC |
142 | |
143 | # This generates a heck of a lot of oks, but I think it's necessary. | |
144 | my $amount = 1; | |
145 | sub prepend_block_counting_filter { | |
146 | filter_add(sub { | |
8498a518 | 147 | my $output = $_; |
937b367d NC |
148 | my $count = 256; |
149 | while (--$count) { | |
150 | $_ = ''; | |
151 | my $status = filter_read($amount); | |
152 | cmp_ok (length $_, '<=', $amount, "block mode works?"); | |
153 | $output .= $_; | |
154 | if ($status <= 0 or /\n/s) { | |
155 | $_ = $output; | |
156 | return $status; | |
157 | } | |
158 | } | |
159 | die "Looping infinitely"; | |
160 | ||
161 | }) | |
162 | } | |
163 | ||
164 | open $fh, "<", \<<'EOC'; | |
165 | BEGIN {prepend_block_counting_filter}; | |
166 | pass("one by one"); | |
167 | pass("and again"); | |
168 | EOC | |
169 | ||
170 | do [$fh, sub {return;}] or die; | |
171 | ||
172 | open $fh, "<", \<<'EOC'; | |
173 | BEGIN {prepend_block_counting_filter}; | |
174 | pas("SSS make s fast SSS"); | |
175 | EOC | |
176 | ||
16d5c2f8 AT |
177 | TODO: { |
178 | todo_skip "disabled under -Dmad", 50 if $Config{mad}; | |
179 | do [$fh, sub {s/s/ss/gs; s/([\nS])/$1$1$1/gs; return;}] or die; | |
180 | } | |
941a98a0 NC |
181 | |
182 | sub prepend_line_counting_filter { | |
183 | filter_add(sub { | |
184 | my $output = $_; | |
185 | $_ = ''; | |
186 | my $status = filter_read(); | |
187 | my $newlines = tr/\n//; | |
188 | cmp_ok ($newlines, '<=', 1, "1 line at most?"); | |
189 | $_ = $output . $_ if defined $output; | |
190 | return $status; | |
191 | }) | |
192 | } | |
193 | ||
194 | open $fh, "<", \<<'EOC'; | |
195 | BEGIN {prepend_line_counting_filter}; | |
196 | pass("You should see this line thrice"); | |
197 | EOC | |
198 | ||
199 | do [$fh, sub {$_ .= $_ . $_; return;}] or die; | |
34113e50 NC |
200 | |
201 | do \"pass\n(\n'Scalar references are treated as initial file contents'\n)\n" | |
202 | or die; | |
203 | ||
204 | open $fh, "<", \"ss('The file is concatentated');"; | |
205 | ||
206 | do [\'pa', $fh] or die; | |
207 | ||
208 | open $fh, "<", \"ff('Gur svygre vf bayl eha ba gur svyr');"; | |
209 | ||
210 | do [\'pa', $fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/; return;}] or die; | |
211 | ||
212 | open $fh, "<", \"SS('State also works');"; | |
213 | ||
214 | do [\'pa', $fh, sub {s/($_[1])/lc $1/ge; return;}, "S"] or die; | |
215 | ||
216 | @lines = ('ss', '(', "'you can use a generator'", ')'); | |
217 | ||
218 | do [\'pa', \&generator] or die; | |
219 | ||
220 | do [\'pa', \&generator_with_state, | |
221 | ["ss('And generators which take state');\n", | |
222 | "pass('And return multiple lines');\n", | |
223 | ]] or die; |