From 74f6c1ca58b1c40741f55591ab97a77b6751f510 Mon Sep 17 00:00:00 2001
From: Slaven Rezic <slaven@rezic.de>
Date: Tue, 6 Feb 2007 00:04:07 +0100
Subject: [PATCH] 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
---
 MANIFEST                          |  1 +
 ext/PerlIO/encoding/encoding.pm   |  2 +-
 ext/PerlIO/encoding/encoding.xs   | 12 +++++++++++-
 ext/PerlIO/encoding/t/nolooping.t |  9 +++++++++
 4 files changed, 22 insertions(+), 2 deletions(-)
 create mode 100644 ext/PerlIO/encoding/t/nolooping.t

diff --git a/MANIFEST b/MANIFEST
index 760c921584ee..41874528b76a 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 c99e70b5a6d2..dcc65f91e803 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 362d66cd840c..617842f617b6 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 000000000000..9ed1e445de4c
--- /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