X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fio%2Flayers.t;h=c399b2ad8f5ad05d285803248d0adf4467c7d743;hb=584420f022db57225e9644b9c6668ff9f567984a;hp=d0e37a3c8dbe0b57a38d15fafed39cff99ad1292;hpb=43651d81392f71a2868d35b75782d354b0139c90;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/io/layers.t b/t/io/layers.t index d0e37a3..c399b2a 100644 --- a/t/io/layers.t +++ b/t/io/layers.t @@ -31,16 +31,33 @@ my $DOSISH = $^O =~ /^(?:MSWin32|os2|dos|NetWare|mint)$/ ? 1 : 0; $DOSISH = 1 if !$DOSISH and $^O =~ /^uwin/; my $NONSTDIO = exists $ENV{PERLIO} && $ENV{PERLIO} ne 'stdio' ? 1 : 0; my $FASTSTDIO = $Config{d_faststdio} && $Config{usefaststdio} ? 1 : 0; +my $UTF8_STDIN; +if (${^UNICODE} & 1) { + if (${^UNICODE} & 64) { + # Conditional on the locale + $UTF8_STDIN = ${^UTF8LOCALE}; + } else { + # Unconditional + $UTF8_STDIN = 1; + } +} else { + $UTF8_STDIN = 0; +} +my $NTEST = 44 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 5 : 0) + + $UTF8_STDIN; -my $NTEST = 43 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 5 : 0); +sub PerlIO::F_UTF8 () { 0x00008000 } # from perliol.h plan tests => $NTEST; print <<__EOH__; -# PERLIO = $PERLIO -# DOSISH = $DOSISH -# NONSTDIO = $NONSTDIO -# FASTSTDIO = $FASTSTDIO +# PERLIO = $PERLIO +# DOSISH = $DOSISH +# NONSTDIO = $NONSTDIO +# FASTSTDIO = $FASTSTDIO +# UNICODE = ${^UNICODE} +# UTF8LOCALE = ${^UTF8LOCALE} +# UTF8_STDIN = $UTF8_STDIN __EOH__ SKIP: { @@ -91,7 +108,7 @@ SKIP: { @$expected = grep { $_ ne 'crlf' } @$expected; } my $n = scalar @$expected; - is($n, scalar @$expected, "$id - layers == $n"); + is(scalar @$result, $n, "$id - layers == $n"); for (my $i = 0; $i < $n; $i++) { my $j = $expected->[$i]; if (ref $j eq 'CODE') { @@ -105,7 +122,7 @@ SKIP: { } check([ PerlIO::get_layers(STDIN) ], - [ "stdio" ], + $UTF8_STDIN ? [ "stdio", "utf8" ] : [ "stdio" ], "STDIN"); open(F, ">:crlf", "afile"); @@ -197,5 +214,12 @@ SKIP: { close G; } + # Check that PL_sigwarn's reference count is correct, and that + # &PerlIO::Layer::NoWarnings isn't prematurely freed. + fresh_perl_like (<<'EOT', qr/^CODE/); +open(UTF, "<:raw:encoding(utf8)", "afile") or die $!; +print ref *PerlIO::Layer::NoWarnings{CODE}; +EOT + 1 while unlink "afile"; }