1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gatemy $PERLIO; 4*0Sstevel@tonic-gate 5*0Sstevel@tonic-gateBEGIN { 6*0Sstevel@tonic-gate chdir 't' if -d 't'; 7*0Sstevel@tonic-gate @INC = '../lib'; 8*0Sstevel@tonic-gate require './test.pl'; 9*0Sstevel@tonic-gate unless (find PerlIO::Layer 'perlio') { 10*0Sstevel@tonic-gate print "1..0 # Skip: not perlio\n"; 11*0Sstevel@tonic-gate exit 0; 12*0Sstevel@tonic-gate } 13*0Sstevel@tonic-gate eval 'use Encode'; 14*0Sstevel@tonic-gate if ($@ =~ /dynamic loading not available/) { 15*0Sstevel@tonic-gate print "1..0 # miniperl cannot load Encode\n"; 16*0Sstevel@tonic-gate exit 0; 17*0Sstevel@tonic-gate } 18*0Sstevel@tonic-gate # Makes testing easier. 19*0Sstevel@tonic-gate $ENV{PERLIO} = 'stdio' if exists $ENV{PERLIO} && $ENV{PERLIO} eq ''; 20*0Sstevel@tonic-gate if (exists $ENV{PERLIO} && $ENV{PERLIO} !~ /^(stdio|perlio|mmap)$/) { 21*0Sstevel@tonic-gate # We are not prepared for anything else. 22*0Sstevel@tonic-gate print "1..0 # PERLIO='$ENV{PERLIO}' unknown\n"; 23*0Sstevel@tonic-gate exit 0; 24*0Sstevel@tonic-gate } 25*0Sstevel@tonic-gate $PERLIO = exists $ENV{PERLIO} ? $ENV{PERLIO} : "(undef)"; 26*0Sstevel@tonic-gate} 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gateuse Config; 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gatemy $DOSISH = $^O =~ /^(?:MSWin32|os2|dos|NetWare|mint)$/ ? 1 : 0; 31*0Sstevel@tonic-gate $DOSISH = 1 if !$DOSISH and $^O =~ /^uwin/; 32*0Sstevel@tonic-gatemy $NONSTDIO = exists $ENV{PERLIO} && $ENV{PERLIO} ne 'stdio' ? 1 : 0; 33*0Sstevel@tonic-gatemy $FASTSTDIO = $Config{d_faststdio} && $Config{usefaststdio} ? 1 : 0; 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gatemy $NTEST = 43 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 5 : 0); 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gateplan tests => $NTEST; 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gateprint <<__EOH__; 40*0Sstevel@tonic-gate# PERLIO = $PERLIO 41*0Sstevel@tonic-gate# DOSISH = $DOSISH 42*0Sstevel@tonic-gate# NONSTDIO = $NONSTDIO 43*0Sstevel@tonic-gate# FASTSTDIO = $FASTSTDIO 44*0Sstevel@tonic-gate__EOH__ 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gateSKIP: { 47*0Sstevel@tonic-gate # FIXME - more of these could be tested without Encode or full perl 48*0Sstevel@tonic-gate skip("This perl does not have Encode", $NTEST) 49*0Sstevel@tonic-gate unless " $Config{extensions} " =~ / Encode /; 50*0Sstevel@tonic-gate skip("miniperl does not have Encode", $NTEST) if $ENV{PERL_CORE_MINITEST}; 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gate sub check { 53*0Sstevel@tonic-gate my ($result, $expected, $id) = @_; 54*0Sstevel@tonic-gate # An interesting dance follows where we try to make the following 55*0Sstevel@tonic-gate # IO layer stack setups to compare equal: 56*0Sstevel@tonic-gate # 57*0Sstevel@tonic-gate # PERLIO UNIX-like DOS-like 58*0Sstevel@tonic-gate # 59*0Sstevel@tonic-gate # unset / "" unix perlio / stdio [1] unix crlf 60*0Sstevel@tonic-gate # stdio unix perlio / stdio [1] stdio 61*0Sstevel@tonic-gate # perlio unix perlio unix perlio 62*0Sstevel@tonic-gate # mmap unix mmap unix mmap 63*0Sstevel@tonic-gate # 64*0Sstevel@tonic-gate # [1] "stdio" if Configure found out how to do "fast stdio" (depends 65*0Sstevel@tonic-gate # on the stdio implementation) and in Perl 5.8, otherwise "unix perlio" 66*0Sstevel@tonic-gate # 67*0Sstevel@tonic-gate if ($NONSTDIO) { 68*0Sstevel@tonic-gate # Get rid of "unix". 69*0Sstevel@tonic-gate shift @$result if $result->[0] eq "unix"; 70*0Sstevel@tonic-gate # Change expectations. 71*0Sstevel@tonic-gate if ($FASTSTDIO) { 72*0Sstevel@tonic-gate $expected->[0] = $ENV{PERLIO}; 73*0Sstevel@tonic-gate } else { 74*0Sstevel@tonic-gate $expected->[0] = $ENV{PERLIO} if $expected->[0] eq "stdio"; 75*0Sstevel@tonic-gate } 76*0Sstevel@tonic-gate } elsif (!$FASTSTDIO && !$DOSISH) { 77*0Sstevel@tonic-gate splice(@$result, 0, 2, "stdio") 78*0Sstevel@tonic-gate if @$result >= 2 && 79*0Sstevel@tonic-gate $result->[0] eq "unix" && 80*0Sstevel@tonic-gate $result->[1] eq "perlio"; 81*0Sstevel@tonic-gate } elsif ($DOSISH) { 82*0Sstevel@tonic-gate splice(@$result, 0, 2, "stdio") 83*0Sstevel@tonic-gate if @$result >= 2 && 84*0Sstevel@tonic-gate $result->[0] eq "unix" && 85*0Sstevel@tonic-gate $result->[1] eq "crlf"; 86*0Sstevel@tonic-gate } 87*0Sstevel@tonic-gate if ($DOSISH && grep { $_ eq 'crlf' } @$expected) { 88*0Sstevel@tonic-gate # 5 tests potentially skipped because 89*0Sstevel@tonic-gate # DOSISH systems already have a CRLF layer 90*0Sstevel@tonic-gate # which will make new ones not stick. 91*0Sstevel@tonic-gate @$expected = grep { $_ ne 'crlf' } @$expected; 92*0Sstevel@tonic-gate } 93*0Sstevel@tonic-gate my $n = scalar @$expected; 94*0Sstevel@tonic-gate is($n, scalar @$expected, "$id - layers == $n"); 95*0Sstevel@tonic-gate for (my $i = 0; $i < $n; $i++) { 96*0Sstevel@tonic-gate my $j = $expected->[$i]; 97*0Sstevel@tonic-gate if (ref $j eq 'CODE') { 98*0Sstevel@tonic-gate ok($j->($result->[$i]), "$id - $i is ok"); 99*0Sstevel@tonic-gate } else { 100*0Sstevel@tonic-gate is($result->[$i], $j, 101*0Sstevel@tonic-gate sprintf("$id - $i is %s", 102*0Sstevel@tonic-gate defined $j ? $j : "undef")); 103*0Sstevel@tonic-gate } 104*0Sstevel@tonic-gate } 105*0Sstevel@tonic-gate } 106*0Sstevel@tonic-gate 107*0Sstevel@tonic-gate check([ PerlIO::get_layers(STDIN) ], 108*0Sstevel@tonic-gate [ "stdio" ], 109*0Sstevel@tonic-gate "STDIN"); 110*0Sstevel@tonic-gate 111*0Sstevel@tonic-gate open(F, ">:crlf", "afile"); 112*0Sstevel@tonic-gate 113*0Sstevel@tonic-gate check([ PerlIO::get_layers(F) ], 114*0Sstevel@tonic-gate [ qw(stdio crlf) ], 115*0Sstevel@tonic-gate "open :crlf"); 116*0Sstevel@tonic-gate 117*0Sstevel@tonic-gate binmode(F, ":encoding(sjis)"); # "sjis" will be canonized to "shiftjis" 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gate check([ PerlIO::get_layers(F) ], 120*0Sstevel@tonic-gate [ qw[stdio crlf encoding(shiftjis) utf8] ], 121*0Sstevel@tonic-gate ":encoding(sjis)"); 122*0Sstevel@tonic-gate 123*0Sstevel@tonic-gate binmode(F, ":pop"); 124*0Sstevel@tonic-gate 125*0Sstevel@tonic-gate check([ PerlIO::get_layers(F) ], 126*0Sstevel@tonic-gate [ qw(stdio crlf) ], 127*0Sstevel@tonic-gate ":pop"); 128*0Sstevel@tonic-gate 129*0Sstevel@tonic-gate binmode(F, ":raw"); 130*0Sstevel@tonic-gate 131*0Sstevel@tonic-gate check([ PerlIO::get_layers(F) ], 132*0Sstevel@tonic-gate [ "stdio" ], 133*0Sstevel@tonic-gate ":raw"); 134*0Sstevel@tonic-gate 135*0Sstevel@tonic-gate binmode(F, ":utf8"); 136*0Sstevel@tonic-gate 137*0Sstevel@tonic-gate check([ PerlIO::get_layers(F) ], 138*0Sstevel@tonic-gate [ qw(stdio utf8) ], 139*0Sstevel@tonic-gate ":utf8"); 140*0Sstevel@tonic-gate 141*0Sstevel@tonic-gate binmode(F, ":bytes"); 142*0Sstevel@tonic-gate 143*0Sstevel@tonic-gate check([ PerlIO::get_layers(F) ], 144*0Sstevel@tonic-gate [ "stdio" ], 145*0Sstevel@tonic-gate ":bytes"); 146*0Sstevel@tonic-gate 147*0Sstevel@tonic-gate binmode(F, ":encoding(utf8)"); 148*0Sstevel@tonic-gate 149*0Sstevel@tonic-gate check([ PerlIO::get_layers(F) ], 150*0Sstevel@tonic-gate [ qw[stdio encoding(utf8) utf8] ], 151*0Sstevel@tonic-gate ":encoding(utf8)"); 152*0Sstevel@tonic-gate 153*0Sstevel@tonic-gate binmode(F, ":raw :crlf"); 154*0Sstevel@tonic-gate 155*0Sstevel@tonic-gate check([ PerlIO::get_layers(F) ], 156*0Sstevel@tonic-gate [ qw(stdio crlf) ], 157*0Sstevel@tonic-gate ":raw:crlf"); 158*0Sstevel@tonic-gate 159*0Sstevel@tonic-gate binmode(F, ":raw :encoding(latin1)"); # "latin1" will be canonized 160*0Sstevel@tonic-gate 161*0Sstevel@tonic-gate # 7 tests potentially skipped. 162*0Sstevel@tonic-gate unless ($DOSISH || !$FASTSTDIO) { 163*0Sstevel@tonic-gate my @results = PerlIO::get_layers(F, details => 1); 164*0Sstevel@tonic-gate 165*0Sstevel@tonic-gate # Get rid of the args and the flags. 166*0Sstevel@tonic-gate splice(@results, 1, 2) if $NONSTDIO; 167*0Sstevel@tonic-gate 168*0Sstevel@tonic-gate check([ @results ], 169*0Sstevel@tonic-gate [ "stdio", undef, sub { $_[0] > 0 }, 170*0Sstevel@tonic-gate "encoding", "iso-8859-1", sub { $_[0] & PerlIO::F_UTF8() } ], 171*0Sstevel@tonic-gate ":raw:encoding(latin1)"); 172*0Sstevel@tonic-gate } 173*0Sstevel@tonic-gate 174*0Sstevel@tonic-gate binmode(F); 175*0Sstevel@tonic-gate 176*0Sstevel@tonic-gate check([ PerlIO::get_layers(F) ], 177*0Sstevel@tonic-gate [ "stdio" ], 178*0Sstevel@tonic-gate "binmode"); 179*0Sstevel@tonic-gate 180*0Sstevel@tonic-gate close F; 181*0Sstevel@tonic-gate 182*0Sstevel@tonic-gate { 183*0Sstevel@tonic-gate use open(IN => ":crlf", OUT => ":encoding(cp1252)"); 184*0Sstevel@tonic-gate 185*0Sstevel@tonic-gate open F, "<afile"; 186*0Sstevel@tonic-gate open G, ">afile"; 187*0Sstevel@tonic-gate 188*0Sstevel@tonic-gate check([ PerlIO::get_layers(F, input => 1) ], 189*0Sstevel@tonic-gate [ qw(stdio crlf) ], 190*0Sstevel@tonic-gate "use open IN"); 191*0Sstevel@tonic-gate 192*0Sstevel@tonic-gate check([ PerlIO::get_layers(G, output => 1) ], 193*0Sstevel@tonic-gate [ qw[stdio encoding(cp1252) utf8] ], 194*0Sstevel@tonic-gate "use open OUT"); 195*0Sstevel@tonic-gate 196*0Sstevel@tonic-gate close F; 197*0Sstevel@tonic-gate close G; 198*0Sstevel@tonic-gate } 199*0Sstevel@tonic-gate 200*0Sstevel@tonic-gate 1 while unlink "afile"; 201*0Sstevel@tonic-gate} 202