(perl #127380) default PERLIO_DEBUG/-Di to use STDERR

[perl5.git] / ext / PerlIO-scalar / scalar.xs

diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index fd8ac67..f3dff49 100644 (file)
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -15,7 +15,7 @@ typedef struct {
     Off_t posn;
 } PerlIOScalar;
 
-IV
+static IV
 PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
                    PerlIO_funcs * tab)
 {
@@ -46,7 +46,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
        }
     }
     else {
-       s->var = newSVpvn("", 0);
+       s->var = newSVpvs("");
     }
     SvUPGRADE(s->var, SVt_PV);
 
@@ -55,6 +55,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
     {
        sv_force_normal(s->var);
        SvCUR_set(s->var, 0);
+       if (SvPOK(s->var)) *SvPVX(s->var) = 0;
     }
     if (SvUTF8(s->var) && !sv_utf8_downgrade(s->var, TRUE)) {
        if (ckWARN(WARN_UTF8))
@@ -65,14 +66,14 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
        return -1;
     }
     if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
-       s->posn = sv_len(s->var);
+       s->posn = SvOK(s->var) ? sv_len(s->var) : 0;
     else
        s->posn = 0;
     SvSETMAGIC(s->var);
     return code;
 }
 
-IV
+static IV
 PerlIOScalar_popped(pTHX_ PerlIO * f)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
@@ -83,7 +84,7 @@ PerlIOScalar_popped(pTHX_ PerlIO * f)
     return 0;
 }
 
-IV
+static IV
 PerlIOScalar_close(pTHX_ PerlIO * f)
 {
     IV code = PerlIOBase_close(aTHX_ f);
@@ -91,43 +92,48 @@ PerlIOScalar_close(pTHX_ PerlIO * f)
     return code;
 }
 
-IV
+static IV
 PerlIOScalar_fileno(pTHX_ PerlIO * f)
 {
     PERL_UNUSED_ARG(f);
     return -1;
 }
 
-IV
+static IV
 PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    Off_t new_posn;
 
     switch (whence) {
     case SEEK_SET:
-       s->posn = offset;
+       new_posn = offset;
        break;
     case SEEK_CUR:
-       s->posn = offset + s->posn;
+       new_posn = offset + s->posn;
        break;
     case SEEK_END:
       {
        STRLEN oldcur;
        (void)SvPV(s->var, oldcur);
-       s->posn = offset + oldcur;
+       new_posn = offset + oldcur;
        break;
       }
+    default:
+        SETERRNO(EINVAL, SS_IVCHAN);
+        return -1;
     }
-    if (s->posn < 0) {
+    if (new_posn < 0) {
         if (ckWARN(WARN_LAYER))
            Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string");
        SETERRNO(EINVAL, SS_IVCHAN);
        return -1;
     }
+    s->posn = new_posn;
     return 0;
 }
 
-Off_t
+static Off_t
 PerlIOScalar_tell(pTHX_ PerlIO * f)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
@@ -135,7 +141,7 @@ PerlIOScalar_tell(pTHX_ PerlIO * f)
 }
 
 
-SSize_t
+static SSize_t
 PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     if (!f)
@@ -143,6 +149,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
        PerlIOBase(f)->flags |= PERLIO_F_ERROR;
        SETERRNO(EBADF, SS_IVCHAN);
+       Perl_PerlIO_save_errno(aTHX_ f);
        return 0;
     }
     {
@@ -150,7 +157,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
        SV *sv = s->var;
        char *p;
        STRLEN len;
-       I32 got;
+        STRLEN got;
        p = SvPV(sv, len);
        if (SvUTF8(sv)) {
            if (sv_utf8_downgrade(sv, TRUE)) {
@@ -163,9 +170,15 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
                return -1;
            }
        }
-       got = len - (STRLEN)(s->posn);
-       if (got <= 0)
+        /* I assume that Off_t is at least as large as len (which 
+         * seems safe) and that the size of the buffer in our SV is
+         * always less than half the size of the address space
+         */
+        assert(sizeof(Off_t) >= sizeof(len));
+        assert((Off_t)len >= 0);
+        if ((Off_t)len <= s->posn)
            return 0;
+       got = len - (STRLEN)(s->posn);
        if ((STRLEN)got > (STRLEN)count)
            got = (STRLEN)count;
        Copy(p + (STRLEN)(s->posn), vbuf, got, STDCHAR);
@@ -174,7 +187,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     }
 }
 
-SSize_t
+static SSize_t
 PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
 {
     if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
@@ -198,7 +211,22 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
        }
        else {
            STRLEN const cur = SvCUR(sv);
-           if (s->posn > cur) {
+
+            /* ensure we don't try to create ridiculously large
+             * SVs on small platforms
+             */
+#if Size_t_size < Off_t_size
+            if (s->posn > SSize_t_MAX) {
+#ifdef EFBIG
+                SETERRNO(EFBIG, SS_BUFFEROVF);
+#else
+                SETERRNO(ENOSPC, SS_BUFFEROVF);
+#endif
+                return 0;
+            }
+#endif
+
+           if ((STRLEN)s->posn > cur) {
                dst = SvGROW(sv, (STRLEN)s->posn + count + 1);
                Zero(SvPVX(sv) + cur, (STRLEN)s->posn - cur, char);
            }
@@ -222,21 +250,21 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
        return 0;
 }
 
-IV
+static IV
 PerlIOScalar_fill(pTHX_ PerlIO * f)
 {
     PERL_UNUSED_ARG(f);
     return -1;
 }
 
-IV
+static IV
 PerlIOScalar_flush(pTHX_ PerlIO * f)
 {
     PERL_UNUSED_ARG(f);
     return 0;
 }
 
-STDCHAR *
+static STDCHAR *
 PerlIOScalar_get_base(pTHX_ PerlIO * f)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
@@ -247,7 +275,7 @@ PerlIOScalar_get_base(pTHX_ PerlIO * f)
     return (STDCHAR *) NULL;
 }
 
-STDCHAR *
+static STDCHAR *
 PerlIOScalar_get_ptr(pTHX_ PerlIO * f)
 {
     if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
@@ -257,14 +285,14 @@ PerlIOScalar_get_ptr(pTHX_ PerlIO * f)
     return (STDCHAR *) NULL;
 }
 
-SSize_t
+static SSize_t
 PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
 {
     if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
        PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
        STRLEN len;
        (void)SvPV(s->var,len);
-       if (len > (STRLEN) s->posn)
+       if ((Off_t)len > s->posn)
            return len - (STRLEN)s->posn;
        else
            return 0;
@@ -272,7 +300,7 @@ PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
     return 0;
 }
 
-Size_t
+static Size_t
 PerlIOScalar_bufsiz(pTHX_ PerlIO * f)
 {
     if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) {
@@ -283,7 +311,7 @@ PerlIOScalar_bufsiz(pTHX_ PerlIO * f)
     return 0;
 }
 
-void
+static void
 PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
@@ -293,7 +321,7 @@ PerlIOScalar_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt)
     s->posn = len - cnt;
 }
 
-PerlIO *
+static PerlIO *
 PerlIOScalar_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers, IV n,
                  const char *mode, int fd, int imode, int perm,
                  PerlIO * f, int narg, SV ** args)
@@ -314,7 +342,7 @@ PerlIOScalar_open(pTHX_ PerlIO_funcs * self, PerlIO_list_t * layers, IV n,
     return NULL;
 }
 
-SV *
+static SV *
 PerlIOScalar_arg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
@@ -331,7 +359,7 @@ PerlIOScalar_arg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
     return newRV_noinc(var);
 }
 
-PerlIO *
+static PerlIO *
 PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
                 int flags)
 {
@@ -339,7 +367,7 @@ PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
        ing the cloned scalar to be set to the empty string by
        PerlIOScalar_pushed.  So set aside our scalar temporarily. */
     PerlIOScalar * const os = PerlIOSelf(o, PerlIOScalar);
-    PerlIOScalar *fs;
+    PerlIOScalar *fs = NULL; /* avoid "may be used uninitialized" warning */
     SV * const var = os->var;
     os->var = newSVpvs("");
     if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {
@@ -358,7 +386,7 @@ PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
     return f;
 }
 
-PERLIO_FUNCS_DECL(PerlIO_scalar) = {
+static PERLIO_FUNCS_DECL(PerlIO_scalar) = {
     sizeof(PerlIO_funcs),
     "scalar",
     sizeof(PerlIOScalar),