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         for (my $i = 0; $i < $n; $i++) {
  26             my $j = $expected->[$i];
  27             if (ref $j eq 'CODE') {
  28                 ok($j->($result->[$i]), "$id $i is ok");
  29             } else {
  30                 is($result->[$i], $j,
  31                    sprintf("$id $i is %s", defined $j ? $j : "undef"));
  32             }
  33         }
  34     }
  35
  36     check([ PerlIO::get_layers(STDIN) ],
  37           [ "stdio" ],
  38           "STDIN");
  39
  40     open(F, ">:crlf", "afile");
  41
  42     check([ PerlIO::get_layers(F) ],
  43           [ qw(stdio crlf) ],
  44           "open :crlf");
  45
  46     binmode(F, ":encoding(sjis)"); # "sjis" will be canonized to "shiftjis"
  47
  48     check([ PerlIO::get_layers(F) ],
  49           [ qw[stdio crlf encoding(shiftjis) utf8] ],
  50           ":encoding(sjis)");
  51
  52     binmode(F, ":pop");
  53
  54     check([ PerlIO::get_layers(F) ],
  55           [ qw(stdio crlf) ],
  56           ":pop");
  57
  58     binmode(F, ":raw");
  59
  60     check([ PerlIO::get_layers(F) ],
  61           [ "stdio" ],
  62           ":raw");
  63
  64     binmode(F, ":utf8");
  65
  66     check([ PerlIO::get_layers(F) ],
  67           [ qw(stdio utf8) ],
  68           ":utf8");
  69
  70     binmode(F, ":bytes");
  71
  72     check([ PerlIO::get_layers(F) ],
  73           [ "stdio" ],
  74           ":bytes");
  75
  76     binmode(F, ":encoding(utf8)");
  77
  78     check([ PerlIO::get_layers(F) ],
  79             [ qw[stdio encoding(utf8) utf8] ],
  80             ":encoding(utf8)");
  81
  82     binmode(F, ":raw :crlf");
  83
  84     check([ PerlIO::get_layers(F) ],
  85           [ qw(stdio crlf) ],
  86           ":raw:crlf");
  87
  88     binmode(F, ":raw :encoding(latin1)"); # "latin1" will be canonized
  89
  90     check([ PerlIO::get_layers(F, details => 1) ],
  91           [ "stdio",    undef,        sub { $_[0] > 0 },
  92             "encoding", "iso-8859-1", sub { $_[0] & PerlIO::F_UTF8() } ],
  93           ":raw:encoding(latin1)");
  94
  95     binmode(F);
  96
  97     check([ PerlIO::get_layers(F) ],
  98           [ "stdio" ],
  99           "binmode");
 100
 101     close F;
 102
 103     {
 104         use open(IN => ":crlf", OUT => ":encoding(cp1252)");
 105
 106         open F, "<afile";
 107         open G, ">afile";
 108
 109         check([ PerlIO::get_layers(F, input  => 1) ],
 110               [ qw(stdio crlf) ],
 111               "use open IN");
 112
 113         check([ PerlIO::get_layers(G, output => 1) ],
 114               [ qw[stdio encoding(cp1252) utf8] ],
 115               "use open OUT");
 116
 117         close F;
 118         close G;
 119     }
 120
 121     1 while unlink "afile";
 122 }