t/io/layers.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7     unless (find PerlIO::Layer 'perlio') {
   8         print "1..0 # Skip: not perlio\n";
   9         exit 0;
  10     }
  11 }
  12
  13 plan tests => 43;
  14
  15 use Config;
  16
  17 SKIP: {
  18     skip("This perl does not have Encode", 43)
  19         unless " $Config{extensions} " =~ / Encode /;
  20
  21     sub check {
  22         my ($result, $expected, $id) = @_;
  23         my $n = scalar @$expected;
  24         is($n, scalar @$expected, "$id - layers = $n");
  25         if ($ENV{PERLIO}) {
  26             # Get rid of "unix" and similar OS-specific low lever layer.
  27             shift(@$result);
  28             # Change expectations.
  29             $expected->[0] = "perlio" if $expected->[0] eq "stdio";
  30         }
  31         for (my $i = 0; $i < $n; $i++) {
  32             my $j = $expected->[$i];
  33             if (ref $j eq 'CODE') {
  34                 ok($j->($result->[$i]), "$id - $i is ok");
  35             } else {
  36                 is($result->[$i], $j,
  37                    sprintf("$id - $i is %s", defined $j ? $j : "undef"));
  38             }
  39         }
  40     }
  41
  42     check([ PerlIO::get_layers(STDIN) ],
  43           [ "stdio" ],
  44           "STDIN");
  45
  46     open(F, ">:crlf", "afile");
  47
  48     check([ PerlIO::get_layers(F) ],
  49           [ qw(stdio crlf) ],
  50           "open :crlf");
  51
  52     binmode(F, ":encoding(sjis)"); # "sjis" will be canonized to "shiftjis"
  53
  54     check([ PerlIO::get_layers(F) ],
  55           [ qw[stdio crlf encoding(shiftjis) utf8] ],
  56           ":encoding(sjis)");
  57
  58     binmode(F, ":pop");
  59
  60     check([ PerlIO::get_layers(F) ],
  61           [ qw(stdio crlf) ],
  62           ":pop");
  63
  64     binmode(F, ":raw");
  65
  66     check([ PerlIO::get_layers(F) ],
  67           [ "stdio" ],
  68           ":raw");
  69
  70     binmode(F, ":utf8");
  71
  72     check([ PerlIO::get_layers(F) ],
  73           [ qw(stdio utf8) ],
  74           ":utf8");
  75
  76     binmode(F, ":bytes");
  77
  78     check([ PerlIO::get_layers(F) ],
  79           [ "stdio" ],
  80           ":bytes");
  81
  82     binmode(F, ":encoding(utf8)");
  83
  84     check([ PerlIO::get_layers(F) ],
  85             [ qw[stdio encoding(utf8) utf8] ],
  86             ":encoding(utf8)");
  87
  88     binmode(F, ":raw :crlf");
  89
  90     check([ PerlIO::get_layers(F) ],
  91           [ qw(stdio crlf) ],
  92           ":raw:crlf");
  93
  94     binmode(F, ":raw :encoding(latin1)"); # "latin1" will be canonized
  95
  96     {
  97         my @results = PerlIO::get_layers(F, details => 1);
  98
  99         # Get rid of "unix" and undef.
 100         splice(@results, 0, 2) if $ENV{PERLIO};
 101
 102         check([ @results ],
 103               [ "stdio",    undef,        sub { $_[0] > 0 },
 104                 "encoding", "iso-8859-1", sub { $_[0] & PerlIO::F_UTF8() } ],
 105               ":raw:encoding(latin1)");
 106     }
 107
 108     binmode(F);
 109
 110     check([ PerlIO::get_layers(F) ],
 111           [ "stdio" ],
 112           "binmode");
 113
 114     close F;
 115
 116     {
 117         use open(IN => ":crlf", OUT => ":encoding(cp1252)");
 118
 119         open F, "<afile";
 120         open G, ">afile";
 121
 122         check([ PerlIO::get_layers(F, input  => 1) ],
 123               [ qw(stdio crlf) ],
 124               "use open IN");
 125
 126         check([ PerlIO::get_layers(G, output => 1) ],
 127               [ qw[stdio encoding(cp1252) utf8] ],
 128               "use open OUT");
 129
 130         close F;
 131         close G;
 132     }
 133
 134     1 while unlink "afile";
 135 }