Retract #17331, something broke (e.g. t/io/utf8.t became unhappy)

[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 0a6ab10..df911ed 100644 (file)
--- a/ext/PerlIO/encoding/encoding.xs
+++ b/ext/PerlIO/encoding/encoding.xs
@@ -8,6 +8,8 @@
 #include "XSUB.h"
 #define U8 U8
 
+#define OUR_DEFAULT_FB "Encode::PERLQQ"
+
 #if defined(USE_PERLIO) && !defined(USE_SFIO)
 
 /* Define an encoding "layer" in the perliol.h sense.
@@ -49,7 +51,6 @@ typedef struct {
 } PerlIOEncode;
 
 #define NEEDS_LINES    1
-#define OUR_DEFAULT_FB "Encode::PERLQQ"
 
 SV *
 PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
@@ -396,14 +397,14 @@ PerlIOEncode_flush(pTHX_ PerlIO * f)
     PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
     IV code = 0;
 
-    if (e->bufsv && (e->base.ptr > e->base.buf)) {
+    if (e->bufsv) {
        dSP;
        SV *str;
        char *s;
        STRLEN len;
        SSize_t count = 0;
-       if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) {
-           /* Write case encode the buffer and write() to layer below */
+       if ((PerlIOBase(f)->flags & PERLIO_F_WRBUF) && (e->base.ptr > e->base.buf)) {
+           /* Write case - encode the buffer and write() to layer below */
            PUSHSTACKi(PERLSI_MAGIC);
            SPAGAIN;
            ENTER;
@@ -438,15 +439,17 @@ PerlIOEncode_flush(pTHX_ PerlIO * f)
                return code;
            }
        }
-       else if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
+       else if ((PerlIOBase(f)->flags & PERLIO_F_RDBUF)) {
            /* read case */
            /* if we have any untranslated stuff then unread that first */
+           /* FIXME - unread is fragile is there a better way ? */
            if (e->dataSV && SvCUR(e->dataSV)) {
                s = SvPV(e->dataSV, len);
                count = PerlIO_unread(PerlIONext(f),s,len);
                if ((STRLEN)count != len) {
                    code = -1;
                }
+               SvCUR_set(e->dataSV,0);
            }
            /* See if there is anything left in the buffer */
            if (e->base.ptr < e->base.end) {
@@ -495,9 +498,18 @@ IV
 PerlIOEncode_close(pTHX_ PerlIO * f)
 {
     PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
-    IV code = PerlIOBase_close(aTHX_ f);
-
+    IV code;
+    if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
+       /* Discard partial character */
+       if (e->dataSV) {
+           SvCUR_set(e->dataSV,0);
+       }
+       /* Don't back decode and unread any pending data */
+       e->base.ptr = e->base.end = e->base.buf;
+    }
+    code = PerlIOBase_close(aTHX_ f);
     if (e->bufsv) {
+       /* This should only fire for write case */
        if (e->base.buf && e->base.ptr > e->base.buf) {
            Perl_croak(aTHX_ "Close with partial character");
        }
@@ -578,6 +590,7 @@ PerlIO_funcs PerlIO_encode = {
     PerlIOEncode_pushed,
     PerlIOEncode_popped,
     PerlIOBuf_open,
+    NULL, /* binmode - always pop */
     PerlIOEncode_getarg,
     PerlIOBase_fileno,
     PerlIOEncode_dup,
@@ -615,7 +628,7 @@ BOOT:
      */
     PUSHSTACKi(PERLSI_MAGIC);
     SPAGAIN;
-    if (!gv_stashpvn("Encode", 6, FALSE)) {
+    if (!get_cv(OUR_DEFAULT_FB, 0)) {
 #if 0
        /* This would just be an irritant now loading works */
        Perl_warner(aTHX_ packWARN(WARN_IO), ":encoding without 'use Encode'");
@@ -628,7 +641,6 @@ BOOT:
        SPAGAIN;
        LEAVE;
     }
-#ifdef PERLIO_LAYERS
     PUSHMARK(sp);
     PUTBACK;
     if (call_pv(OUR_DEFAULT_FB, G_SCALAR) != 1) {
@@ -638,6 +650,7 @@ BOOT:
     SPAGAIN;
     sv_setsv(chk, POPs);
     PUTBACK;
+#ifdef PERLIO_LAYERS
     PerlIO_define_layer(aTHX_ &PerlIO_encode);
 #endif
     POPSTACK;