diff options
| -rw-r--r-- | perlio.c | 14 | ||||
| -rwxr-xr-x | t/io/utf8.t | 27 |
2 files changed, 26 insertions, 15 deletions
@@ -158,7 +158,11 @@ PerlIO_intmode2str(int rawmode, char *mode, int *writing) int PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) { - if (!names || !*names || strEQ(names, ":crlf") || strEQ(names, ":raw")) { + if (!names || !*names + || strEQ(names, ":crlf") + || strEQ(names, ":raw") + || strEQ(names, ":bytes") + ) { return 0; } Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl", names); @@ -1099,6 +1103,12 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names) return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE; } else { + if (*f) { + /* Turn off UTF-8-ness, to undo UTF-8 locale effects + This may be too simplistic! + */ + PerlIOBase(f)->flags &= ~PERLIO_F_UTF8; + } /* FIXME?: Looking down the layer stack seems wrong, but is a way of reaching past (say) an encoding layer to flip CRLF-ness of the layer(s) below @@ -1686,7 +1696,7 @@ PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) PerlIO_funcs PerlIO_utf8 = { "utf8", sizeof(PerlIOl), - PERLIO_K_DUMMY | PERLIO_F_UTF8, + PERLIO_K_DUMMY | PERLIO_K_UTF8, PerlIOUtf8_pushed, NULL, NULL, diff --git a/t/io/utf8.t b/t/io/utf8.t index af356fc88f..e1ecf1c433 100755 --- a/t/io/utf8.t +++ b/t/io/utf8.t @@ -66,17 +66,17 @@ close(F); { $a = chr(300); # This *is* UTF-encoded $b = chr(130); # This is not. - + open F, ">:utf8", 'a' or die $!; print F $a,"\n"; close F; - + open F, "<:utf8", 'a' or die $!; $x = <F>; chomp($x); print "not " unless $x eq chr(300); print "ok 14\n"; - + open F, "a" or die $!; # Not UTF binmode(F, ":bytes"); $x = <F>; @@ -86,9 +86,10 @@ close(F); print "not " unless $x eq $chr; print "ok 15\n"; close F; - + open F, ">:utf8", 'a' or die $!; binmode(F); # we write a "\n" and then tell() - avoid CRLF issues. + binmode(F,":utf8"); # turn UTF-8-ness back on print F $a; my $y; { my $x = tell(F); @@ -96,30 +97,30 @@ close(F); print "not " unless $x == $y; print "ok 16\n"; } - + { # Check byte length of $b use bytes; my $y = length($b); print "not " unless $y == 1; print "ok 17\n"; } - + print F $b,"\n"; # Don't upgrades $b - + { # Check byte length of $b use bytes; my $y = length($b); print "not ($y) " unless $y == 1; print "ok 18\n"; } - + { my $x = tell(F); { use bytes; if (ord('A')==193){$y += 2;}else{$y += 3;}} # EBCDIC ASCII print "not ($x,$y) " unless $x == $y; print "ok 19\n"; } - + close F; - + open F, "a" or die $!; # Not UTF binmode(F, ":bytes"); $x = <F>; @@ -128,14 +129,14 @@ close(F); if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC printf "not (%vd) ", $x unless $x eq $chr; print "ok 20\n"; - + open F, "<:utf8", "a" or die $!; $x = <F>; chomp($x); close F; printf "not (%vd) ", $x unless $x eq chr(300).chr(130); print "ok 21\n"; - + open F, ">", "a" or die $!; if (${^OPEN} =~ /:utf8/) { binmode(F, ":bytes:"); @@ -158,7 +159,7 @@ print F $a; binmode(F, ":bytes"); print F chr(130)."\n"; close F; - + open F, "<", "a" or die $!; binmode(F, ":bytes"); $x = <F>; chomp $x; |