Commit | Line | Data |
bde61959 |
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 |
8 | if ($ENV{PERL_CORE_MINITEST}) { |
9 | print "1..0 # Skip: no dynamic loading on miniperl\n"; |
10 | exit 0; |
11 | } |
bde61959 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
72 | |
73 | print "# 2 tests with pipes from subprocesses.\n"; |
74 | |
baf93d00 |
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 |
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 |
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 |
117 | |
118 | my $count = 32; |
119 | sub prepend_rot13_filter { |
120 | filter_add(sub { |
8498a518 |
121 | my $previous = $_; |
5675696b |
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 |
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 |
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 |
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 |
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 |
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 |
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; |