t/io/layers.t

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