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