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