Re: [perl #57322] perlbug AutoReply: ungetc() to :scalar might cause problems

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

diff --git a/ext/PerlIO/scalar/scalar.xs b/ext/PerlIO/scalar/scalar.xs
index 319c851..d9574d7 100644 (file)
--- a/ext/PerlIO/scalar/scalar.xs
+++ b/ext/PerlIO/scalar/scalar.xs
@@ -26,13 +26,14 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
        if (SvROK(arg)) {
            if (SvREADONLY(SvRV(arg)) && mode && *mode != 'r') {
                if (ckWARN(WARN_LAYER))
-                   Perl_warner(aTHX_ packWARN(WARN_LAYER), PL_no_modify);
+                   Perl_warner(aTHX_ packWARN(WARN_LAYER), "%s", PL_no_modify);
                SETERRNO(EINVAL, SS_IVCHAN);
                return -1;
            }
            s->var = SvREFCNT_inc(SvRV(arg));
-           if (!SvPOK(s->var) && SvTYPE(SvRV(arg)) > SVt_NULL)
-               (void)SvPV_nolen(s->var);
+           SvGETMAGIC(s->var);
+           if (!SvPOK(s->var) && SvOK(s->var))
+               (void)SvPV_nomg_const_nolen(s->var);
        }
        else {
            s->var =
@@ -108,6 +109,10 @@ PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
        Zero(SvPVX(s->var) + oldcur, newlen - oldcur, char);
        /* No SvCUR_set(), though.  This is just a seek, not a write. */
     }
+    else if (!SvPVX(s->var)) {
+       /* ensure there's always a character buffer */
+       (void)SvGROW(s->var,1);
+    }
     SvPOK_on(s->var);
     return 0;
 }
@@ -120,17 +125,6 @@ PerlIOScalar_tell(pTHX_ PerlIO * f)
 }
 
 SSize_t
-PerlIOScalar_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
-{
-    PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
-    char *dst = SvGROW(s->var, (STRLEN)s->posn + count);
-    s->posn -= count;
-    Move(vbuf, dst + s->posn, count, char);
-    SvPOK_on(s->var);
-    return count;
-}
-
-SSize_t
 PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
 {
     if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
@@ -180,7 +174,7 @@ PerlIOScalar_get_base(pTHX_ PerlIO * f)
     if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
        return (STDCHAR *) SvPV_nolen(s->var);
     }
-    return (STDCHAR *) Nullch;
+    return (STDCHAR *) NULL;
 }
 
 STDCHAR *
@@ -190,7 +184,7 @@ PerlIOScalar_get_ptr(pTHX_ PerlIO * f)
        PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
        return PerlIOScalar_get_base(aTHX_ f) + s->posn;
     }
-    return (STDCHAR *) Nullch;
+    return (STDCHAR *) NULL;
 }
 
 SSize_t
@@ -284,7 +278,7 @@ PERLIO_FUNCS_DECL(PerlIO_scalar) = {
     PerlIOScalar_fileno,
     PerlIOScalar_dup,
     PerlIOBase_read,
-    PerlIOScalar_unread,
+    NULL, /* unread */
     PerlIOScalar_write,
     PerlIOScalar_seek,
     PerlIOScalar_tell,