X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/10e621bc35cb48b15b69b5a57242ff004f7455dc..fa9804ae636b8a12f77d0e537f628658d44ea189:/dist/IO/IO.xs

diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
index ac64d17..4b13feb 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -69,6 +69,31 @@ not_here(const char *s)
     NORETURN_FUNCTION_END;
 }
 
+#ifndef UVCHR_IS_INVARIANT   /* For use with Perls without this macro */
+#   if ('A' == 65)
+#       define UVCHR_IS_INVARIANT(cp) ((cp) < 128)
+#   elif (defined(NATIVE_IS_INVARIANT)) /* EBCDIC on old Perl */
+#       define UVCHR_IS_INVARIANT(cp) ((cp) < 256 && NATIVE_IS_INVARIANT(cp))
+#   elif defined(isASCII)    /* EBCDIC on very old Perl */
+        /* In EBCDIC, the invariants are the code points corresponding to ASCII,
+         * plus all the controls.  All but one EBCDIC control is below SPACE; it
+         * varies depending on the code page, determined by the ord of '^' */
+#       define UVCHR_IS_INVARIANT(cp) (isASCII(cp)                            \
+                                       || (cp) < ' '                          \
+                                       || (('^' == 106)    /* POSIX-BC */     \
+                                          ? (cp) == 95                        \
+                                          : (cp) == 0xFF)) /* 1047 or 037 */
+#   else    /* EBCDIC on very very old Perl */
+        /* This assumes isascii() is available, but that could be fixed by
+         * having the macro test for each printable ASCII char */
+#       define UVCHR_IS_INVARIANT(cp) (isascii(cp)                            \
+                                       || (cp) < ' '                          \
+                                       || (('^' == 106)    /* POSIX-BC */     \
+                                          ? (cp) == 95                        \
+                                          : (cp) == 0xFF)) /* 1047 or 037 */
+#   endif
+#endif
+
 
 #ifndef PerlIO
 #define PerlIO_fileno(f) fileno(f)
@@ -77,13 +102,19 @@ not_here(const char *s)
 static int
 io_blocking(pTHX_ InputStream f, int block)
 {
+    int fd = -1;
 #if defined(HAS_FCNTL)
     int RETVAL;
-    if(!f) {
+    if (!f) {
 	errno = EBADF;
 	return -1;
     }
-    RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0);
+    fd = PerlIO_fileno(f);
+    if (fd < 0) {
+      errno = EBADF;
+      return -1;
+    }
+    RETVAL = fcntl(fd, F_GETFL, 0);
     if (RETVAL >= 0) {
 	int mode = RETVAL;
 	int newmode = mode;
@@ -118,7 +149,7 @@ io_blocking(pTHX_ InputStream f, int block)
 	}
 #endif
 	if (newmode != mode) {
-	    const int ret = fcntl(PerlIO_fileno(f),F_SETFL,newmode);
+            const int ret = fcntl(fd, F_SETFL, newmode);
 	    if (ret < 0)
 		RETVAL = ret;
 	}
@@ -129,7 +160,7 @@ io_blocking(pTHX_ InputStream f, int block)
     if (block >= 0) {
 	unsigned long flags = !block;
 	/* ioctl claims to take char* but really needs a u_long sized buffer */
-	const int ret = ioctl(PerlIO_fileno(f), FIONBIO, (char*)&flags);
+	const int ret = ioctl(fd, FIONBIO, (char*)&flags);
 	if (ret != 0)
 	    return -1;
 	/* Win32 has no way to get the current blocking status of a socket.
@@ -337,7 +368,7 @@ ungetc(handle, c)
                 croak("Negative character number in ungetc()");
 
             v = SvUV(c);
-            if (NATIVE_IS_INVARIANT(v) || (v <= 0xFF && !PerlIO_isutf8(handle)))
+            if (UVCHR_IS_INVARIANT(v) || (v <= 0xFF && !PerlIO_isutf8(handle)))
                 RETVAL = PerlIO_ungetc(handle, (int)v);
             else {
                 U8 buf[UTF8_MAXBYTES + 1], *end;
@@ -350,7 +381,7 @@ ungetc(handle, c)
                  * above-Unicodes */
                 end = uvchr_to_utf8_flags(buf, v, 0);
                 len = end - buf;
-                if (PerlIO_unread(handle, &buf, len) == len)
+                if ((Size_t)PerlIO_unread(handle, &buf, len) == len)
                     XSRETURN_UV(v);
                 else
                     RETVAL = EOF;
@@ -499,9 +530,15 @@ fsync(arg)
 	handle = IoOFP(sv_2io(arg));
 	if (!handle)
 	    handle = IoIFP(sv_2io(arg));
-	if(handle)
-	    RETVAL = fsync(PerlIO_fileno(handle));
-	else {
+	if (handle) {
+	    int fd = PerlIO_fileno(handle);
+	    if (fd >= 0) {
+		RETVAL = fsync(fd);
+	    } else {
+		RETVAL = -1;
+		errno = EBADF;
+	    }
+	} else {
 	    RETVAL = -1;
 	    errno = EINVAL;
 	}
@@ -513,8 +550,6 @@ fsync(arg)
 
 SV *
 _create_getline_subs(const char *code)
-    PREINIT:
-	SV *ret;
     CODE:
 	OP *(*io_old_ck_lineseq)(pTHX_ OP *) = PL_check[OP_LINESEQ];
 	PL_check[OP_LINESEQ] = io_ck_lineseq;
@@ -531,18 +566,27 @@ sockatmark (sock)
    InputStream sock
    PROTOTYPE: $
    PREINIT:
-     int fd;
+     int fd = PerlIO_fileno(sock);
    CODE:
    {
-     fd = PerlIO_fileno(sock);
 #ifdef HAS_SOCKATMARK
-     RETVAL = sockatmark(fd);
+     if (fd < 0) {
+       errno = EBADF;
+       RETVAL = -1;
+     } else {
+       RETVAL = sockatmark(fd);
+     }
 #else
      {
+     if (fd < 0) {
+       errno = EBADF;
+       RETVAL = -1;
+     }
+     else {
        int flag = 0;
 #   ifdef SIOCATMARK
 #     if defined(NETWARE) || defined(WIN32)
-       if (ioctl(fd, SIOCATMARK, (void*)&flag) != 0)
+       if (ioctl(fd, SIOCATMARK, (char*)&flag) != 0)
 #     else
        if (ioctl(fd, SIOCATMARK, &flag) != 0)
 #     endif
@@ -552,6 +596,7 @@ sockatmark (sock)
 #   endif
        RETVAL = flag;
      }
+     }
 #endif
    }
    OUTPUT: