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