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;