From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Fri, 30 Mar 2007 08:30:35 +0000 (+0000)
Subject: When dup'ing a filehandle, retain the :utf8 layer
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f0720f70fca1466afb0baffc79f6af7a9e80f428;p=p5sagit%2Fp5-mst-13.2.git

When dup'ing a filehandle, retain the :utf8 layer

p4raw-id: //depot/perl@30781
---

diff --git a/perlio.c b/perlio.c
index ef07055..bbb12db 100644
--- a/perlio.c
+++ b/perlio.c
@@ -2268,6 +2268,8 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
 	if (self->Getarg)
 	    arg = (*self->Getarg)(aTHX_ o, param, flags);
 	f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
+	if (PerlIOBase(o)->flags & PERLIO_F_UTF8)
+	    PerlIOBase(f)->flags |= PERLIO_F_UTF8;
 	if (arg)
 	    SvREFCNT_dec(arg);
     }
diff --git a/t/io/dup.t b/t/io/dup.t
index 48497fd..0287023 100755
--- a/t/io/dup.t
+++ b/t/io/dup.t
@@ -10,7 +10,7 @@ use Config;
 no warnings 'once';
 
 my $test = 1;
-print "1..26\n";
+print "1..29\n";
 print "ok 1\n";
 
 open(DUPOUT,">&STDOUT");
@@ -133,5 +133,25 @@ SKIP: {
     }
     close G;
 
+    use utf8;
+    open UTFOUT, '>:utf8', "dup$$" or die $!;
+    open UTFDUP, '>&UTFOUT' or die $!;
+    my $message = "ça marche pas\n";
+    print UTFOUT $message;
+    print UTFDUP $message;
+    binmode UTFDUP, ':utf8';
+    print UTFDUP $message;
+    close UTFOUT;
+    close UTFDUP;
+    open(UTFIN, "<:utf8", "dup$$") or die $!;
+    {
+	my $line;
+	$line = <UTFIN>; is($line, $message);
+	$line = <UTFIN>; is($line, $message);
+	$line = <UTFIN>; is($line, $message);
+    }
+    close UTFIN;
+    no utf8;
+
     END { 1 while unlink "dup$$" }
 }