This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Build fixes for Win32 after the Coverity smoke.
[perl5.git] / dist / IO / IO.xs
index ac64d17..4b13feb 100644 (file)
@@ -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: