X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FPerlIO%2Fencoding%2Fencoding.xs;h=617842f617b6b69cf365a25b0143659af92eb377;hb=74f6c1ca58b1c40741f55591ab97a77b6751f510;hp=5f7b0dff5e3209a87ce0f0ec97e3fb3b8dba96ec;hpb=a6d0563455796929d2aae5a18fb57e80a20f87bd;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs
index 5f7b0df..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
@@ -113,12 +114,13 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs *
 	code = -1;
     }
     else {
-#ifdef USE_NEW_SEQUENCE
+
+       /* $enc->renew */
 	PUSHMARK(sp);
 	XPUSHs(result);
 	PUTBACK;
-	if (call_method("new_sequence",G_SCALAR|G_EVAL) != 1 || SvTRUE(ERRSV)) {
-	    Perl_warner(aTHX_ packWARN(WARN_IO), "\"%" SVf "\" does not support new_sequence",
+	if (call_method("renew",G_SCALAR|G_EVAL) != 1 || SvTRUE(ERRSV)) {
+	    Perl_warner(aTHX_ packWARN(WARN_IO), "\"%" SVf "\" does not support renew method",
 			arg);
 	}
 	else {
@@ -126,7 +128,6 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs *
 	    result = POPs;
 	    PUTBACK;
 	}
-#endif
 	e->enc = newSVsv(result);
 	PUSHMARK(sp);
 	XPUSHs(e->enc);
@@ -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;
@@ -255,7 +257,7 @@ PerlIOEncode_fill(pTHX_ PerlIO * f)
 	STDCHAR *ptr = PerlIO_get_ptr(n);
 	SSize_t use  = (avail >= 0) ? avail : 0;
 	SV *uni;
-	char *s;
+	char *s = Nullch;
 	STRLEN len = 0;
 	e->base.ptr = e->base.end = (STDCHAR *) Nullch;
 	(void) PerlIOEncode_get_base(aTHX_ f);
@@ -308,8 +310,8 @@ PerlIOEncode_fill(pTHX_ PerlIO * f)
 	}
 	else {
 	    /* Create a "dummy" SV to represent the available data from layer below */
-	    if (SvLEN(e->dataSV) && SvPVX(e->dataSV)) {
-		Safefree(SvPVX(e->dataSV));
+	    if (SvLEN(e->dataSV) && SvPVX_const(e->dataSV)) {
+		Safefree(SvPVX_mutable(e->dataSV));
 	    }
 	    if (use > (SSize_t)e->base.bufsiz) {
 		if (e->flags & NEEDS_LINES) {
@@ -321,8 +323,8 @@ PerlIOEncode_fill(pTHX_ PerlIO * f)
 	       use = e->base.bufsiz;
 	    }
 	    }
-	    SvPVX(e->dataSV) = (char *) ptr;
-	    SvLEN(e->dataSV) = 0;  /* Hands off sv.c - it isn't yours */
+	    SvPV_set(e->dataSV, (char *) ptr);
+	    SvLEN_set(e->dataSV, 0);  /* Hands off sv.c - it isn't yours */
 	    SvCUR_set(e->dataSV,use);
 	    SvPOK_only(e->dataSV);
 	}
@@ -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
 		 */
@@ -462,8 +469,8 @@ PerlIOEncode_flush(pTHX_ PerlIO * f)
 		SAVETMPS;
 		str = sv_newmortal();
 		sv_upgrade(str, SVt_PV);
-		SvPVX(str) = (char*)e->base.ptr;
-		SvLEN(str) = 0;
+		SvPV_set(str, (char*)e->base.ptr);
+		SvLEN_set(str, 0);
 		SvCUR_set(str, e->base.end - e->base.ptr);
 		SvPOK_only(str);
 		SvUTF8_on(str);
@@ -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;