From: Slaven Rezic <slaven@rezic.de>
Date: Mon, 5 Feb 2007 23:04:07 +0000 (+0100)
Subject: Re: [perl #41442] segfault (dead loop) with Encoding, use open :locale, print STDERR
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=74f6c1ca58b1c40741f55591ab97a77b6751f510;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #41442] segfault (dead loop) with Encoding, use open :locale, print STDERR
Message-ID: <87veiggt2g.fsf@biokovo.herceg.de>

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

diff --git a/MANIFEST b/MANIFEST
index 760c921..4187452 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -933,6 +933,7 @@ ext/PerlIO/encoding/encoding.pm	PerlIO::encoding
 ext/PerlIO/encoding/encoding.xs	PerlIO::encoding
 ext/PerlIO/encoding/Makefile.PL	PerlIO::encoding makefile writer
 ext/PerlIO/encoding/MANIFEST	PerlIO::encoding list of files
+ext/PerlIO/encoding/t/nolooping.t	Tests for PerlIO::encoding
 ext/PerlIO/scalar/Makefile.PL	PerlIO layer for scalars
 ext/PerlIO/scalar/scalar.pm	PerlIO layer for scalars
 ext/PerlIO/scalar/scalar.xs	PerlIO layer for scalars
diff --git a/ext/PerlIO/encoding/encoding.pm b/ext/PerlIO/encoding/encoding.pm
index c99e70b..dcc65f9 100644
--- a/ext/PerlIO/encoding/encoding.pm
+++ b/ext/PerlIO/encoding/encoding.pm
@@ -1,7 +1,7 @@
 package PerlIO::encoding;
 
 use strict;
-our $VERSION = '0.09';
+our $VERSION = '0.10';
 our $DEBUG = 0;
 $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n";
 
diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs
index 362d66c..617842f 100644
--- a/ext/PerlIO/encoding/encoding.xs
+++ b/ext/PerlIO/encoding/encoding.xs
@@ -48,6 +48,7 @@ typedef struct {
     SV *enc;			/* the encoding object */
     SV *chk;                    /* CHECK in Encode methods */
     int flags;			/* Flags currently just needs lines */
+    int inEncodeCall;		/* trap recursive encode calls */
 } PerlIOEncode;
 
 #define NEEDS_LINES	1
@@ -147,6 +148,7 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs *
     }
 
     e->chk = newSVsv(get_sv("PerlIO::encoding::fallback", 0));
+    e->inEncodeCall = 0;
 
     FREETMPS;
     LEAVE;
@@ -404,6 +406,7 @@ PerlIOEncode_flush(pTHX_ PerlIO * f)
 	STRLEN len;
 	SSize_t count = 0;
 	if ((PerlIOBase(f)->flags & PERLIO_F_WRBUF) && (e->base.ptr > e->base.buf)) {
+	    if (e->inEncodeCall) return 0;
 	    /* Write case - encode the buffer and write() to layer below */
 	    PUSHSTACKi(PERLSI_MAGIC);
 	    SPAGAIN;
@@ -416,9 +419,12 @@ PerlIOEncode_flush(pTHX_ PerlIO * f)
 	    XPUSHs(e->bufsv);
 	    XPUSHs(e->chk);
 	    PUTBACK;
+	    e->inEncodeCall = 1;
 	    if (call_method("encode", G_SCALAR) != 1) {
+		e->inEncodeCall = 0;
 		Perl_die(aTHX_ "panic: encode did not return a value");
 	    }
+	    e->inEncodeCall = 0;
 	    SPAGAIN;
 	    str = POPs;
 	    PUTBACK;
@@ -453,6 +459,7 @@ PerlIOEncode_flush(pTHX_ PerlIO * f)
 	    }
 	    /* See if there is anything left in the buffer */
 	    if (e->base.ptr < e->base.end) {
+		if (e->inEncodeCall) return 0;
 		/* Bother - have unread data.
 		   re-encode and unread() to layer below
 		 */
@@ -472,9 +479,12 @@ PerlIOEncode_flush(pTHX_ PerlIO * f)
 		XPUSHs(str);
 		XPUSHs(e->chk);
 		PUTBACK;
+		e->inEncodeCall = 1;
 		if (call_method("encode", G_SCALAR) != 1) {
-		     Perl_die(aTHX_ "panic: encode did not return a value");
+		    e->inEncodeCall = 0;
+		    Perl_die(aTHX_ "panic: encode did not return a value");
 		}
+		e->inEncodeCall = 0;
 		SPAGAIN;
 		str = POPs;
 		PUTBACK;
diff --git a/ext/PerlIO/encoding/t/nolooping.t b/ext/PerlIO/encoding/t/nolooping.t
new file mode 100644
index 0000000..9ed1e44
--- /dev/null
+++ b/ext/PerlIO/encoding/t/nolooping.t
@@ -0,0 +1,9 @@
+#!perl -w
+
+use Test::More tests => 1;
+
+# bug #41442
+use open ':locale';
+if (-e '/dev/null') { open STDERR, '>', '/dev/null' }
+warn "# \x{201e}\n"; # &bdquo;
+ok(1); # we got that far