binmode(FH); to act like binmode(FH,":bytes") as well as

turning off CRLF features.

p4raw-id: //depot/perlio@17171

diff --git a/perlio.c b/perlio.c
index e1cbbdc..304107b 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -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 af356fc..e1ecf1c 100755 (executable)
--- 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;