This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add a test for [perl #17753].
[perl5.git] / t / io / layers.t
CommitLineData
39f7a870
JH
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
491abfa0
JH
7 unless (find PerlIO::Layer 'perlio') {
8 print "1..0 # Skip: not perlio\n";
9 exit 0;
10 }
e76300d6
JH
11 if (exists $ENV{PERLIO} && $ENV{PERLIO} ne 'stdio') {
12 print "1..0 # PERLIO non-stdio\n";
13 exit(0);
14 }
39f7a870
JH
15}
16
17plan tests => 43;
18
19use Config;
20
491abfa0
JH
21SKIP: {
22 skip("This perl does not have Encode", 43)
23 unless " $Config{extensions} " =~ / Encode /;
39f7a870
JH
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)");
491abfa0 109
39f7a870
JH
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}