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