This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
POSIX: silence some compiler warnings
[perl5.git] / ext / POSIX / POSIX.xs
index 8151d79..6caea48 100644 (file)
@@ -28,6 +28,9 @@
 #include <dirent.h>
 #endif
 #include <errno.h>
+#ifdef WIN32
+#include <sys/errno2.h>
+#endif
 #ifdef I_FLOAT
 #include <float.h>
 #endif
@@ -82,26 +85,6 @@ char *tzname[] = { "" , "" };
 #endif
 #endif
 
-#ifndef PERL_UNUSED_DECL
-#  ifdef HASATTRIBUTE
-#    if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
-#      define PERL_UNUSED_DECL
-#    else
-#      define PERL_UNUSED_DECL __attribute__((unused))
-#    endif
-#  else
-#    define PERL_UNUSED_DECL
-#  endif
-#endif
-
-#ifndef dNOOP
-#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
-#endif
-
-#ifndef dVAR
-#define dVAR dNOOP
-#endif
-
 #if defined(__VMS) && !defined(__POSIX_SOURCE)
 #  include <libdef.h>       /* LIB$_INVARG constant */
 #  include <lib$routines.h> /* prototype for lib$ediv() */
@@ -213,160 +196,6 @@ char *tzname[] = { "" , "" };
 #endif /* WIN32 || NETWARE */
 #endif /* __VMS */
 
-#ifdef WIN32
-   /* Perl on Windows assigns WSAGetLastError() return values to errno
-    * (in win32/win32sck.c).  Therefore we need to map these values
-    * back to standard symbolic names, but only for those names having
-    * no existing value or an existing value >= 100. (VC++ 2010 defines
-    * a group of names with values >= 100 in its errno.h which we *do*
-    * need to redefine.) The Errno.pm module does a similar mapping.
-    */
-#  ifdef EWOULDBLOCK
-#    undef EWOULDBLOCK
-#  endif
-#  define EWOULDBLOCK WSAEWOULDBLOCK
-#  ifdef EINPROGRESS
-#    undef EINPROGRESS
-#  endif
-#  define EINPROGRESS WSAEINPROGRESS
-#  ifdef EALREADY
-#    undef EALREADY
-#  endif
-#  define EALREADY WSAEALREADY
-#  ifdef ENOTSOCK
-#    undef ENOTSOCK
-#  endif
-#  define ENOTSOCK WSAENOTSOCK
-#  ifdef EDESTADDRREQ
-#    undef EDESTADDRREQ
-#  endif
-#  define EDESTADDRREQ WSAEDESTADDRREQ
-#  ifdef EMSGSIZE
-#    undef EMSGSIZE
-#  endif
-#  define EMSGSIZE WSAEMSGSIZE
-#  ifdef EPROTOTYPE
-#    undef EPROTOTYPE
-#  endif
-#  define EPROTOTYPE WSAEPROTOTYPE
-#  ifdef ENOPROTOOPT
-#    undef ENOPROTOOPT
-#  endif
-#  define ENOPROTOOPT WSAENOPROTOOPT
-#  ifdef EPROTONOSUPPORT
-#    undef EPROTONOSUPPORT
-#  endif
-#  define EPROTONOSUPPORT WSAEPROTONOSUPPORT
-#  ifdef ESOCKTNOSUPPORT
-#    undef ESOCKTNOSUPPORT
-#  endif
-#  define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
-#  ifdef EOPNOTSUPP
-#    undef EOPNOTSUPP
-#  endif
-#  define EOPNOTSUPP WSAEOPNOTSUPP
-#  ifdef EPFNOSUPPORT
-#    undef EPFNOSUPPORT
-#  endif
-#  define EPFNOSUPPORT WSAEPFNOSUPPORT
-#  ifdef EAFNOSUPPORT
-#    undef EAFNOSUPPORT
-#  endif
-#  define EAFNOSUPPORT WSAEAFNOSUPPORT
-#  ifdef EADDRINUSE
-#    undef EADDRINUSE
-#  endif
-#  define EADDRINUSE WSAEADDRINUSE
-#  ifdef EADDRNOTAVAIL
-#    undef EADDRNOTAVAIL
-#  endif
-#  define EADDRNOTAVAIL WSAEADDRNOTAVAIL
-#  ifdef ENETDOWN
-#    undef ENETDOWN
-#  endif
-#  define ENETDOWN WSAENETDOWN
-#  ifdef ENETUNREACH
-#    undef ENETUNREACH
-#  endif
-#  define ENETUNREACH WSAENETUNREACH
-#  ifdef ENETRESET
-#    undef ENETRESET
-#  endif
-#  define ENETRESET WSAENETRESET
-#  ifdef ECONNABORTED
-#    undef ECONNABORTED
-#  endif
-#  define ECONNABORTED WSAECONNABORTED
-#  ifdef ECONNRESET
-#    undef ECONNRESET
-#  endif
-#  define ECONNRESET WSAECONNRESET
-#  ifdef ENOBUFS
-#    undef ENOBUFS
-#  endif
-#  define ENOBUFS WSAENOBUFS
-#  ifdef EISCONN
-#    undef EISCONN
-#  endif
-#  define EISCONN WSAEISCONN
-#  ifdef ENOTCONN
-#    undef ENOTCONN
-#  endif
-#  define ENOTCONN WSAENOTCONN
-#  ifdef ESHUTDOWN
-#    undef ESHUTDOWN
-#  endif
-#  define ESHUTDOWN WSAESHUTDOWN
-#  ifdef ETOOMANYREFS
-#    undef ETOOMANYREFS
-#  endif
-#  define ETOOMANYREFS WSAETOOMANYREFS
-#  ifdef ETIMEDOUT
-#    undef ETIMEDOUT
-#  endif
-#  define ETIMEDOUT WSAETIMEDOUT
-#  ifdef ECONNREFUSED
-#    undef ECONNREFUSED
-#  endif
-#  define ECONNREFUSED WSAECONNREFUSED
-#  ifdef ELOOP
-#    undef ELOOP
-#  endif
-#  define ELOOP WSAELOOP
-#  ifdef EHOSTDOWN
-#    undef EHOSTDOWN
-#  endif
-#  define EHOSTDOWN WSAEHOSTDOWN
-#  ifdef EHOSTUNREACH
-#    undef EHOSTUNREACH
-#  endif
-#  define EHOSTUNREACH WSAEHOSTUNREACH
-#  ifdef EPROCLIM
-#    undef EPROCLIM
-#  endif
-#  define EPROCLIM WSAEPROCLIM
-#  ifdef EUSERS
-#    undef EUSERS
-#  endif
-#  define EUSERS WSAEUSERS
-#  ifdef EDQUOT
-#    undef EDQUOT
-#  endif
-#  define EDQUOT WSAEDQUOT
-#  ifdef ESTALE
-#    undef ESTALE
-#  endif
-#  define ESTALE WSAESTALE
-#  ifdef EREMOTE
-#    undef EREMOTE
-#  endif
-#  define EREMOTE WSAEREMOTE
-#  ifdef EDISCON
-#    undef EDISCON
-#  endif
-#  define EDISCON WSAEDISCON
-#endif
-
 typedef int SysRet;
 typedef long SysRetLong;
 typedef sigset_t* POSIX__SigSet;
@@ -393,9 +222,11 @@ typedef struct termios* POSIX__Termios;
 
 /* Possibly needed prototypes */
 #ifndef WIN32
+START_EXTERN_C
 double strtod (const char *, char **);
 long strtol (const char *, char **, int);
 unsigned long strtoul (const char *, char **, int);
+END_EXTERN_C
 #endif
 
 #ifndef HAS_DIFFTIME
@@ -566,7 +397,7 @@ const struct lconv_offset lconv_integers[] = {
  * as expected. The better solution would be not to use the W*() macros
  * in the first place, though. -- Ingo Weinhold
  */
-#if defined(__BEOS__) || defined(__HAIKU__)
+#if defined(__HAIKU__)
 #    define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
 #else
 #    define WMUNGE(x) (x)
@@ -713,6 +544,83 @@ my_tzset(pTHX)
     tzset();
 }
 
+typedef int (*isfunc_t)(int);
+typedef void (*any_dptr_t)(void *);
+
+/* This needs to be ALIASed in a custom way, hence can't easily be defined as
+   a regular XSUB.  */
+static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */
+static XSPROTO(is_common)
+{
+    dXSARGS;
+    if (items != 1)
+       croak_xs_usage(cv,  "charstring");
+
+    {
+       dXSTARG;
+       STRLEN  len;
+       int     RETVAL;
+       unsigned char *s = (unsigned char *) SvPV(ST(0), len);
+       unsigned char *e = s + len;
+       isfunc_t isfunc = (isfunc_t) XSANY.any_dptr;
+
+       for (RETVAL = 1; RETVAL && s < e; s++)
+           if (!isfunc(*s))
+               RETVAL = 0;
+       XSprePUSH;
+       PUSHi((IV)RETVAL);
+    }
+    XSRETURN(1);
+}
+
+MODULE = POSIX         PACKAGE = POSIX
+
+BOOT:
+{
+    CV *cv;
+    const char *file = __FILE__;
+
+
+    /* silence compiler warning about not_here() defined but not used */
+    if (0) not_here("");
+
+    /* Ensure we get the function, not a macro implementation. Like the C89
+       standard says we can...  */
+#undef isalnum
+    cv = newXS("POSIX::isalnum", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &isalnum;
+#undef isalpha
+    cv = newXS("POSIX::isalpha", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &isalpha;
+#undef iscntrl
+    cv = newXS("POSIX::iscntrl", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &iscntrl;
+#undef isdigit
+    cv = newXS("POSIX::isdigit", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &isdigit;
+#undef isgraph
+    cv = newXS("POSIX::isgraph", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &isgraph;
+#undef islower
+    cv = newXS("POSIX::islower", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &islower;
+#undef isprint
+    cv = newXS("POSIX::isprint", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &isprint;
+#undef ispunct
+    cv = newXS("POSIX::ispunct", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &ispunct;
+#undef isspace
+    cv = newXS("POSIX::isspace", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &isspace;
+#undef isupper
+    cv = newXS("POSIX::isupper", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &isupper;
+#undef isxdigit
+    cv = newXS("POSIX::isxdigit", is_common, file);
+    XSANY.any_dptr = (any_dptr_t) &isxdigit;
+}
+
 MODULE = SigSet                PACKAGE = POSIX::SigSet         PREFIX = sig
 
 void
@@ -787,12 +695,23 @@ getattr(termios_ref, fd = 0)
     OUTPUT:
        RETVAL
 
+# If we define TCSANOW here then both a found and not found constant sub
+# are created causing a Constant subroutine TCSANOW redefined warning
+#ifndef TCSANOW
+#  define DEF_SETATTR_ACTION 0
+#else
+#  define DEF_SETATTR_ACTION TCSANOW
+#endif
 SysRet
-setattr(termios_ref, fd = 0, optional_actions = 0)
+setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
        POSIX::Termios  termios_ref
        int             fd
        int             optional_actions
     CODE:
+       /* The second argument to the call is mandatory, but we'd like to give
+          it a useful default. 0 isn't valid on all operating systems - on
+          Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
+          values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF.  */
        RETVAL = tcsetattr(fd, optional_actions, termios_ref);
     OUTPUT:
        RETVAL
@@ -829,6 +748,8 @@ getiflag(termios_ref)
        case 3:
            RETVAL = termios_ref->c_lflag;
            break;
+        default:
+           RETVAL = 0; /* silence compiler warning */
        }
 #else
        not_here(GvNAME(CvGV(cv)));
@@ -976,160 +897,6 @@ WEXITSTATUS(status)
     OUTPUT:
        RETVAL
 
-int
-isalnum(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!isalnum(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-int
-isalpha(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!isalpha(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-int
-iscntrl(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!iscntrl(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-int
-isdigit(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!isdigit(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-int
-isgraph(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!isgraph(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-int
-islower(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!islower(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-int
-isprint(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!isprint(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-int
-ispunct(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!ispunct(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-int
-isspace(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!isspace(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-int
-isupper(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!isupper(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
-int
-isxdigit(charstring)
-       SV *    charstring
-    PREINIT:
-       STRLEN  len;
-    CODE:
-       unsigned char *s = (unsigned char *) SvPV(charstring, len);
-       unsigned char *e = s + len;
-       for (RETVAL = 1; RETVAL && s < e; s++)
-           if (!isxdigit(*s))
-               RETVAL = 0;
-    OUTPUT:
-       RETVAL
-
 SysRet
 open(filename, flags = O_RDONLY, mode = 0666)
        char *          filename
@@ -1185,7 +952,10 @@ setlocale(category, locale = 0)
        char *          retval;
     CODE:
        retval = setlocale(category, locale);
-       if (retval) {
+       if (! retval) {
+            XSRETURN_UNDEF;
+        }
+        else {
            /* Save retval since subsequent setlocale() calls
             * may overwrite it. */
            RETVAL = savepv(retval);
@@ -1241,13 +1011,10 @@ setlocale(category, locale = 0)
            }
 #endif /* USE_LOCALE_NUMERIC */
        }
-       else
-           RETVAL = NULL;
     OUTPUT:
        RETVAL
     CLEANUP:
-        if (RETVAL)
-           Safefree(RETVAL);
+        Safefree(RETVAL);
 
 NV
 acos(x)
@@ -1524,6 +1291,8 @@ sigpending(sigset)
        RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
     OUTPUT:
        RETVAL
+    CLEANUP:
+    PERL_ASYNC_CHECK();
 
 SysRet
 sigprocmask(how, sigset, oldsigset = 0)
@@ -1552,17 +1321,20 @@ _exit(status)
        int             status
 
 SysRet
-close(fd)
-       int             fd
-
-SysRet
-dup(fd)
-       int             fd
-
-SysRet
 dup2(fd1, fd2)
        int             fd1
        int             fd2
+    CODE:
+#ifdef WIN32
+       /* RT #98912 - More Microsoft muppetry - failing to actually implemented
+          the well known documented POSIX behaviour for a POSIX API.
+          http://msdn.microsoft.com/en-us/library/8syseb29.aspx   */
+       RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
+#else
+       RETVAL = dup2(fd1, fd2);
+#endif
+    OUTPUT:
+       RETVAL
 
 SV *
 lseek(fd, offset, whence)
@@ -1792,15 +1564,29 @@ SysRet
 mkfifo(filename, mode)
        char *          filename
        Mode_t          mode
+    ALIAS:
+       access = 1
     CODE:
-       TAINT_PROPER("mkfifo");
-       RETVAL = mkfifo(filename, mode);
+       if(ix) {
+           RETVAL = access(filename, mode);
+       } else {
+           TAINT_PROPER("mkfifo");
+           RETVAL = mkfifo(filename, mode);
+       }
     OUTPUT:
        RETVAL
 
 SysRet
 tcdrain(fd)
        int             fd
+    ALIAS:
+       close = 1
+       dup = 2
+    CODE:
+       RETVAL = ix == 1 ? close(fd)
+           : (ix < 1 ? tcdrain(fd) : dup(fd));
+    OUTPUT:
+       RETVAL
 
 
 SysRet
@@ -1816,7 +1602,7 @@ tcflow(fd, action)
     OUTPUT:
        RETVAL
 
-char *
+void
 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
        int             sec
        int             min
@@ -1827,10 +1613,13 @@ asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
        int             wday
        int             yday
        int             isdst
-    CODE:
+    ALIAS:
+       mktime = 1
+    PPCODE:
        {
+           dXSTARG;
            struct tm mytm;
-           init_tm(&mytm);     /* XXX workaround - see init_tm() above */
+           init_tm(&mytm);     /* XXX workaround - see init_tm() in core util.c */
            mytm.tm_sec = sec;
            mytm.tm_min = min;
            mytm.tm_hour = hour;
@@ -1840,10 +1629,20 @@ asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
            mytm.tm_wday = wday;
            mytm.tm_yday = yday;
            mytm.tm_isdst = isdst;
-           RETVAL = asctime(&mytm);
+           if (ix) {
+               const time_t result = mktime(&mytm);
+               if (result == (time_t)-1)
+                   SvOK_off(TARG);
+               else if (result == 0)
+                   sv_setpvn(TARG, "0 but true", 10);
+               else
+                   sv_setiv(TARG, (IV)result);
+           } else {
+               sv_setpv(TARG, asctime(&mytm));
+           }
+           ST(0) = TARG;
+           XSRETURN(1);
        }
-    OUTPUT:
-       RETVAL
 
 long
 clock()
@@ -1870,35 +1669,6 @@ difftime(time1, time2)
        Time_t          time1
        Time_t          time2
 
-SysRetLong
-mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
-       int             sec
-       int             min
-       int             hour
-       int             mday
-       int             mon
-       int             year
-       int             wday
-       int             yday
-       int             isdst
-    CODE:
-       {
-           struct tm mytm;
-           init_tm(&mytm);     /* XXX workaround - see init_tm() above */
-           mytm.tm_sec = sec;
-           mytm.tm_min = min;
-           mytm.tm_hour = hour;
-           mytm.tm_mday = mday;
-           mytm.tm_mon = mon;
-           mytm.tm_year = year;
-           mytm.tm_wday = wday;
-           mytm.tm_yday = yday;
-           mytm.tm_isdst = isdst;
-           RETVAL = (SysRetLong) mktime(&mytm);
-       }
-    OUTPUT:
-       RETVAL
-
 #XXX: if $xsubpp::WantOptimize is always the default
 #     sv_setpv(TARG, ...) could be used rather than
 #     ST(0) = sv_2mortal(newSVpv(...))
@@ -1939,11 +1709,6 @@ tzname()
        PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
        PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
 
-SysRet
-access(filename, mode)
-       char *          filename
-       Mode_t          mode
-
 char *
 ctermid(s = 0)
        char *          s = 0;
@@ -1984,28 +1749,24 @@ pathconf(filename, name)
 
 SysRet
 pause()
+    CLEANUP:
+    PERL_ASYNC_CHECK();
+
+unsigned int
+sleep(seconds)
+       unsigned int    seconds
+    CODE:
+       RETVAL = PerlProc_sleep(seconds);
+    OUTPUT:
+       RETVAL
 
 SysRet
 setgid(gid)
        Gid_t           gid
-    CLEANUP:
-#ifndef WIN32
-       if (RETVAL >= 0) {
-           PL_gid  = getgid();
-           PL_egid = getegid();
-       }
-#endif
 
 SysRet
 setuid(uid)
        Uid_t           uid
-    CLEANUP:
-#ifndef WIN32
-       if (RETVAL >= 0) {
-           PL_uid  = getuid();
-           PL_euid = geteuid();
-       }
-#endif
 
 SysRetLong
 sysconf(name)