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