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