Re: [perl #41442] segfault (dead loop) with Encoding, use open :locale, print STDERR

[p5sagit/p5-mst-13.2.git] / ext / PerlIO / encoding / encoding.xs

diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs
index 5f7b0df..617842f 100644 (file)
--- 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;