X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/14d04a33467fd25c9767918f61a2bfaec64b0cfa..b6990ae0c41eccbe44ff95183c3f5a1f24b50382:/perlio.c

diff --git a/perlio.c b/perlio.c
index a593c48..2e5a77d 100644
--- 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);