This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
-Dmad breaks a few tests
[perl5.git] / t / op / incfilter.t
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;
15 use Config;
16 use Filter::Util::Call;
17
18 plan(tests => 141);
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");';
28 do $fh or die;
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
42 do \&generator or die;
43
44 @lines = @origlines;
45 # Check that the array dereferencing works ready for the more complex tests:
46 do [\&generator] or die;
47
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;
59    
60
61 open $fh, "<", \'fail("File handles and filters work from \@INC");';
62
63 do [$fh, sub {s/fail/pass/; return;}] or die;
64
65 open $fh, "<", \'fail("File handles and filters with state work from \@INC");';
66
67 do [$fh, sub {s/$_[1]/pass/; return;}, 'fail'] or die;
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
77 do [$fh, sub {s/$_[1]/pass/; return;}, 'fail'] or die;
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
99 do [$fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/; return;}] or die;
100
101 my $count = 32;
102 sub prepend_rot13_filter {
103     filter_add(sub {
104                    my $previous = $_;
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();
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
124 do [$fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/; return;}] or die;
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 {
130                    my $output = $_;
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
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 }
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;
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;