Update DB_File to CPAN version 1.828

[perl5.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index a593c48..2e5a77d 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -141,17 +141,6 @@ perlsio_binmode(FILE *fp, int iotype, int mode)
      * This used to be contents of do_binmode in doio.c
      */
 #ifdef DOSISH
-#  if defined(atarist)
-    PERL_UNUSED_ARG(iotype);
-    if (!fflush(fp)) {
-        if (mode & O_BINARY)
-            ((FILE *) fp)->_flag |= _IOBIN;
-        else
-            ((FILE *) fp)->_flag &= ~_IOBIN;
-        return 1;
-    }
-    return 0;
-#  else
     dTHX;
     PERL_UNUSED_ARG(iotype);
 #ifdef NETWARE
@@ -163,7 +152,6 @@ perlsio_binmode(FILE *fp, int iotype, int mode)
     }
     else
         return 0;
-#  endif
 #else
 #  if defined(USEMYBINMODE)
     dTHX;
@@ -462,7 +450,7 @@ PerlIO_debug(const char *fmt, ...)
     dSYS;
     va_start(ap, fmt);
     if (!PL_perlio_debug_fd) {
-       if (!PL_tainting &&
+       if (!TAINTING_get &&
            PerlProc_getuid() == PerlProc_geteuid() &&
            PerlProc_getgid() == PerlProc_getegid()) {
            const char * const s = PerlEnv_getenv("PERLIO_DEBUG");
@@ -478,7 +466,6 @@ PerlIO_debug(const char *fmt, ...)
        }
     }
     if (PL_perlio_debug_fd > 0) {
-       dTHX;
 #ifdef USE_ITHREADS
        const char * const s = CopFILE(PL_curcop);
        /* Use fixed buffer as sv_catpvf etc. needs SVs */
@@ -824,7 +811,8 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
        len = strlen(name);
     for (i = 0; i < PL_known_layers->cur; i++) {
        PerlIO_funcs * const f = PL_known_layers->array[i].funcs;
-       if (memEQ(f->name, name, len) && f->name[len] == 0) {
+        const STRLEN this_len = strlen(f->name);
+        if (this_len == len && memEQ(f->name, name, len)) {
            PerlIO_debug("%.*s => %p\n", (int) len, name, (void*)f);
            return f;
        }
@@ -1018,7 +1006,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                }
                do {
                    e++;
-               } while (isALNUM(*e));
+               } while (isWORDCHAR(*e));
                llen = e - s;
                if (*e == '(') {
                    int nesting = 1;
@@ -1167,7 +1155,7 @@ PerlIO_default_layers(pTHX)
 {
     dVAR;
     if (!PL_def_layerlist) {
-       const char * const s = (PL_tainting) ? NULL : PerlEnv_getenv("PERLIO");
+       const char * const s = TAINTING_get ? NULL : PerlEnv_getenv("PERLIO");
        PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix;
        PL_def_layerlist = PerlIO_list_alloc(aTHX);
        PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_unix));
@@ -2168,7 +2156,7 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
            SSize_t avail = PerlIO_get_cnt(f);
            SSize_t take = 0;
            if (avail > 0)
-               take = ((SSize_t)count < avail) ? (SSize_t)count : avail;
+               take = (((SSize_t) count >= 0) && ((SSize_t)count < avail)) ? (SSize_t)count : avail;
            if (take > 0) {
                STDCHAR *ptr = PerlIO_get_ptr(f);
                Copy(ptr, buf, take, STDCHAR);
@@ -2349,10 +2337,7 @@ S_more_refcounted_fds(pTHX_ const int new_fd) {
 #ifdef USE_ITHREADS
        MUTEX_UNLOCK(&PL_perlio_mutex);
 #endif
-       /* Can't use PerlIO to write as it allocates memory */
-       PerlLIO_write(PerlIO_fileno(Perl_error_log),
-                     PL_no_mem, strlen(PL_no_mem));
-       my_exit(1);
+       croak_no_mem();
     }
 
     PL_perlio_fd_refcnt_size = new_max;
@@ -2407,7 +2392,6 @@ PerlIOUnix_refcnt_inc(int fd)
 int
 PerlIOUnix_refcnt_dec(int fd)
 {
-    dTHX;
     int cnt = 0;
     if (fd >= 0) {
        dVAR;
@@ -2416,12 +2400,12 @@ PerlIOUnix_refcnt_dec(int fd)
 #endif
        if (fd >= PL_perlio_fd_refcnt_size) {
            /* diag_listed_as: refcnt_dec: fd %d%s */
-           Perl_croak(aTHX_ "refcnt_dec: fd %d >= refcnt_size %d\n",
+           Perl_croak_nocontext("refcnt_dec: fd %d >= refcnt_size %d\n",
                       fd, PL_perlio_fd_refcnt_size);
        }
        if (PL_perlio_fd_refcnt[fd] <= 0) {
            /* diag_listed_as: refcnt_dec: fd %d%s */
-           Perl_croak(aTHX_ "refcnt_dec: fd %d: %d <= 0\n",
+           Perl_croak_nocontext("refcnt_dec: fd %d: %d <= 0\n",
                       fd, PL_perlio_fd_refcnt[fd]);
        }
        cnt = --PL_perlio_fd_refcnt[fd];
@@ -2431,7 +2415,7 @@ PerlIOUnix_refcnt_dec(int fd)
 #endif
     } else {
        /* diag_listed_as: refcnt_dec: fd %d%s */
-       Perl_croak(aTHX_ "refcnt_dec: fd %d < 0\n", fd);
+       Perl_croak_nocontext("refcnt_dec: fd %d < 0\n", fd);
     }
     return cnt;
 }
@@ -2627,10 +2611,15 @@ PerlIOUnix_oflags(const char *mode)
        oflags &= ~O_BINARY;
        mode++;
     }
-    /*
-     * Always open in binary mode
-     */
-    oflags |= O_BINARY;
+    else {
+#ifdef PERLIO_USING_CRLF
+       /*
+        * If neither "t" nor "b" was specified, open the file
+        * in O_BINARY mode.
+        */
+       oflags |= O_BINARY;
+#endif
+    }
     if (*mode || oflags == -1) {
        SETERRNO(EINVAL, LIB_INVARG);
        oflags = -1;
@@ -3805,12 +3794,14 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f)
     while ((l = *p)) {
        if (l->tab == &PerlIO_stdio) {
            PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio);
-           if (s->stdio == f) {
-               dTHX;
+           if (s->stdio == f) { /* not in a loop */
                const int fd = fileno(f);
                if (fd >= 0)
                    PerlIOUnix_refcnt_dec(fd);
-               PerlIO_pop(aTHX_ p);
+               {
+                   dTHX;
+                   PerlIO_pop(aTHX_ p);
+               }
                return;
            }
        }
@@ -4101,7 +4092,7 @@ PerlIOBuf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
             */
            b->posn -= b->bufsiz;
        }
-       if (avail > (SSize_t) count) {
+       if ((SSize_t) count >= 0 && avail > (SSize_t) count) {
            /*
             * If we have space for more than count, just move count
             */
@@ -4151,7 +4142,7 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     }
     while (count > 0) {
        SSize_t avail = b->bufsiz - (b->ptr - b->buf);
-       if ((SSize_t) count < avail)
+       if ((SSize_t) count >= 0 && (SSize_t) count < avail)
            avail = count;
        if (flushptr > buf && flushptr <= buf + avail)
            avail = flushptr - buf;
@@ -4426,7 +4417,7 @@ PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     SSize_t avail = PerlIO_get_cnt(f);
     SSize_t got = 0;
-    if ((SSize_t)count < avail)
+    if ((SSize_t) count >= 0 && (SSize_t)count < avail)
        avail = count;
     if (avail > 0)
        got = PerlIOBuf_read(aTHX_ f, vbuf, avail);
@@ -4586,6 +4577,8 @@ PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
                }
            }
        }
+        if (count > 0)
+            unread += PerlIOBase_unread(aTHX_ f, (const STDCHAR *) vbuf + unread, count);
        return unread;
     }
 }
@@ -4859,8 +4852,8 @@ Perl_PerlIO_stderr(pTHX)
 char *
 PerlIO_getname(PerlIO *f, char *buf)
 {
-    dTHX;
 #ifdef VMS
+    dTHX;
     char *name = NULL;
     bool exported = FALSE;
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
@@ -4876,7 +4869,7 @@ PerlIO_getname(PerlIO *f, char *buf)
 #else
     PERL_UNUSED_ARG(f);
     PERL_UNUSED_ARG(buf);
-    Perl_croak(aTHX_ "Don't know how to get file name");
+    Perl_croak_nocontext("Don't know how to get file name");
     return NULL;
 #endif
 }
@@ -5016,7 +5009,9 @@ PerlIO_stdoutf(const char *fmt, ...)
 PerlIO *
 PerlIO_tmpfile(void)
 {
+#ifndef WIN32
      dTHX;
+#endif
      PerlIO *f = NULL;
 #ifdef WIN32
      const int fd = win32_tmpfd();
@@ -5026,7 +5021,7 @@ PerlIO_tmpfile(void)
 #    if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
      int fd = -1;
      char tempname[] = "/tmp/PerlIO_XXXXXX";
-     const char * const tmpdir = PL_tainting ? NULL : PerlEnv_getenv("TMPDIR");
+     const char * const tmpdir = TAINTING_get ? NULL : PerlEnv_getenv("TMPDIR");
      SV * sv = NULL;
      /*
       * I have no idea how portable mkstemp() is ... NI-S
@@ -5106,9 +5101,9 @@ Perl_PerlIO_context_layers(pTHX_ const char *mode)
 int
 PerlIO_setpos(PerlIO *f, SV *pos)
 {
-    dTHX;
     if (SvOK(pos)) {
        STRLEN len;
+       dTHX;
        const Off_t * const posn = (Off_t *) SvPV(pos, len);
        if (f && len == sizeof(Off_t))
            return PerlIO_seek(f, *posn, SEEK_SET);