From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Mon, 10 Jun 2002 18:40:22 +0000 (+0000)
Subject: binmode(FH); to act like binmode(FH,":bytes") as well as
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6874a2de0b9fdd8dc928c94c0f22e6f2b45cb330;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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;