integrate cfgperl changes into mainline

[p5sagit/p5-mst-13.2.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 40628af..8fa38f2 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -56,7 +56,10 @@ extern "C" int syscall(unsigned long,...);
 
 /* XXX Configure test needed.
    h_errno might not be a simple 'int', especially for multi-threaded
-   applications.  HOST_NOT_FOUND is typically defined in <netdb.h>.
+   applications, see "extern int errno in perl.h".  Creating such
+   a test requires taking into account the differences between
+   compiling multithreaded and singlethreaded ($ccflags et al).
+   HOST_NOT_FOUND is typically defined in <netdb.h>.
 */
 #if defined(HOST_NOT_FOUND) && !defined(h_errno)
 extern int h_errno;
@@ -181,7 +184,115 @@ static int dooneliner _((char *cmd, char *filename));
 #define ZBTLEN 10
 static char zero_but_true[ZBTLEN + 1] = "0 but true";
 
-/* Pushy I/O. */
+#if defined(I_SYS_ACCESS) && !defined(R_OK)
+#  include <sys/access.h>
+#endif
+
+#undef PERL_EFF_ACCESS_R_OK    /* EFFective uid/gid ACCESS R_OK */
+#undef PERL_EFF_ACCESS_W_OK
+#undef PERL_EFF_ACCESS_X_OK
+
+/* F_OK unused: if stat() cannot find it... */
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESS) && defined(EFF_ONLY_OK) && !defined(NO_EFF_ONLY_OK)
+/* Digital UNIX (when the EFF_ONLY_OK gets fixed), UnixWare */
+#   define PERL_EFF_ACCESS_R_OK(p) (access((p), R_OK | EFF_ONLY_OK))
+#   define PERL_EFF_ACCESS_W_OK(p) (access((p), W_OK | EFF_ONLY_OK))
+#   define PERL_EFF_ACCESS_X_OK(p) (access((p), X_OK | EFF_ONLY_OK))
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_EACCESS)
+/* HP SecureWare */
+#   if defined(I_SYS_SECURITY)
+#       include <sys/security.h>
+#   endif
+#   define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
+#   define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
+#   define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF)
+/* AIX */
+#   define PERL_EFF_ACCESS_R_OK(p) (accessx((p), R_OK, ACC_SELF))
+#   define PERL_EFF_ACCESS_W_OK(p) (accessx((p), W_OK, ACC_SELF))
+#   define PERL_EFF_ACCESS_X_OK(p) (accessx((p), X_OK, ACC_SELF))
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESS)      \
+    && (defined(HAS_SETREUID) || defined(HAS_SETRESUID)                \
+       || defined(HAS_SETREGID) || defined(HAS_SETRESGID))
+/* The Hard Way. */
+STATIC int
+emulate_eaccess (const char* path, int mode) {
+    Uid_t ruid = getuid();
+    Uid_t euid = geteuid();
+    Gid_t rgid = getgid();
+    Gid_t egid = getegid();
+    int res;
+
+    MUTEX_LOCK(&PL_cred_mutex);
+#if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID)
+    croak("switching effective uid is not implemented");
+#else
+#ifdef HAS_SETREUID
+    if (setreuid(euid, ruid))
+#else
+#ifdef HAS_SETRESUID
+    if (setresuid(euid, ruid, (Uid_t)-1))
+#endif
+#endif
+       croak("entering effective uid failed");
+#endif
+
+#if !defined(HAS_SETREGID) && !defined(HAS_SETRESGID)
+    croak("switching effective gid is not implemented");
+#else
+#ifdef HAS_SETREGID
+    if (setregid(egid, rgid))
+#else
+#ifdef HAS_SETRESGID
+    if (setresgid(egid, rgid, (Gid_t)-1))
+#endif
+#endif
+       croak("entering effective gid failed");
+#endif
+
+    res = access(path, mode);
+
+#ifdef HAS_SETREUID
+    if (setreuid(ruid, euid))
+#else
+#ifdef HAS_SETRESUID
+    if (setresuid(ruid, euid, (Uid_t)-1))
+#endif
+#endif
+       croak("leaving effective uid failed");
+
+#ifdef HAS_SETREGID
+    if (setregid(rgid, egid))
+#else
+#ifdef HAS_SETRESGID
+    if (setresgid(rgid, egid, (Gid_t)-1))
+#endif
+#endif
+       croak("leaving effective gid failed");
+    MUTEX_UNLOCK(&PL_cred_mutex);
+
+    return res;
+}
+#   define PERL_EFF_ACCESS_R_OK(p) (emulate_eaccess((p), R_OK))
+#   define PERL_EFF_ACCESS_W_OK(p) (emulate_eaccess((p), W_OK))
+#   define PERL_EFF_ACCESS_X_OK(p) (emulate_eaccess((p), X_OK))
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK)
+STATIC int
+emulate_eaccess (const char* path, int mode) {
+    croak("switching effective uid is not implemented");
+    /*NOTREACHED*/
+    return -1;
+}
+#endif
 
 PP(pp_backtick)
 {
@@ -239,6 +350,8 @@ PP(pp_backtick)
 PP(pp_glob)
 {
     OP *result;
+    tryAMAGICunTARGET(iter, -1);
+
     ENTER;
 
 #ifndef VMS
@@ -248,7 +361,7 @@ PP(pp_glob)
         * so for security reasons we must assume the worst.
         */
        TAINT;
-       taint_proper(no_security, "glob");
+       taint_proper(PL_no_security, "glob");
     }
 #endif /* !VMS */
 
@@ -373,12 +486,12 @@ PP(pp_open)
     if (MAXARG > 1)
        sv = POPs;
     if (!isGV(TOPs))
-       DIE(no_usym, "filehandle");
+       DIE(PL_no_usym, "filehandle");
     if (MAXARG <= 1)
        sv = GvSV(TOPs);
     gv = (GV*)POPs;
     if (!isGV(gv))
-       DIE(no_usym, "filehandle");
+       DIE(PL_no_usym, "filehandle");
     if (GvIOp(gv))
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
     tmps = SvPV(sv, len);
@@ -402,9 +515,9 @@ PP(pp_close)
     else
        gv = (GV*)POPs;
 
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
        PUSHMARK(SP);
-       XPUSHs(mg->mg_obj);
+       XPUSHs(SvTIED_obj((SV*)gv, mg));
        PUTBACK;
        ENTER;
        perl_call_method("CLOSE", G_SCALAR);
@@ -434,7 +547,7 @@ PP(pp_pipe_op)
        goto badexit;
 
     if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
-       DIE(no_usym, "filehandle");
+       DIE(PL_no_usym, "filehandle");
     rstio = GvIOn(rgv);
     wstio = GvIOn(wgv);
 
@@ -459,13 +572,16 @@ PP(pp_pipe_op)
        else PerlLIO_close(fd[1]);
        goto badexit;
     }
-
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+    fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd);  /* ensure close-on-exec */
+    fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd);  /* ensure close-on-exec */
+#endif
     RETPUSHYES;
 
 badexit:
     RETPUSHUNDEF;
 #else
-    DIE(no_func, "pipe");
+    DIE(PL_no_func, "pipe");
 #endif
 }
 
@@ -596,8 +712,8 @@ PP(pp_tie)
     sv = TOPs;
     POPSTACK;
     if (sv_isobject(sv)) {
-       sv_unmagic(varsv, how);            
-       sv_magic(varsv, sv, how, Nullch, 0);
+       sv_unmagic(varsv, how);
+       sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
     }
     LEAVE;
     SP = PL_stack_base + markoff;
@@ -608,18 +724,12 @@ PP(pp_tie)
 PP(pp_untie)
 {
     djSP;
-    SV * sv ;
-
-    sv = POPs;
+    SV *sv = POPs;
+    char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
 
     if (ckWARN(WARN_UNTIE)) {
         MAGIC * mg ;
-        if (SvMAGICAL(sv)) {
-            if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
-                mg = mg_find(sv, 'P') ;
-            else
-                mg = mg_find(sv, 'q') ;
-    
+        if (mg = SvTIED_mg(sv, how)) {
             if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
                warner(WARN_UNTIE,
                    "untie attempted while %lu inner references still exist",
@@ -627,30 +737,23 @@ PP(pp_untie)
         }
     }
  
-    if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
-       sv_unmagic(sv, 'P');
-    else
-       sv_unmagic(sv, 'q');
+    sv_unmagic(sv, how);
     RETPUSHYES;
 }
 
 PP(pp_tied)
 {
     djSP;
-    SV * sv ;
-    MAGIC * mg ;
+    SV *sv = POPs;
+    char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
+    MAGIC *mg;
 
-    sv = POPs;
-    if (SvMAGICAL(sv)) {
-        if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
-            mg = mg_find(sv, 'P') ;
-        else
-            mg = mg_find(sv, 'q') ;
-
-        if (mg)  {
-            PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ; 
-            RETURN ;
-       }
+    if (mg = SvTIED_mg(sv, how)) {
+       SV *osv = SvTIED_obj(sv, mg);
+       if (osv == mg->mg_obj)
+           osv = sv_mortalcopy(osv);
+       PUSHs(osv);
+       RETURN;
     }
     RETPUSHUNDEF;
 }
@@ -754,24 +857,29 @@ PP(pp_sselect)
            maxlen = j;
     }
 
+/* little endians can use vecs directly */
 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
-/* XXX Configure test needed. */
-#if defined(__linux__) || defined(OS2) || defined(NeXT) || defined(__osf__) || defined(sun)
+#  if SELECT_MIN_BITS > 1
+    /* If SELECT_MIN_BITS is greater than one we most probably will want
+     * to align the sizes with SELECT_MIN_BITS/8 because for example
+     * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
+     * UNIX, Solaris, NeXT) the smallest quantum select() operates on
+     * (sets bit) is 32 bits.  */
+    growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
+#  else
     growsize = sizeof(fd_set);
-#else
-    growsize = maxlen;         /* little endians can use vecs directly */
-#endif
-#else
-#ifdef NFDBITS
+#  endif
+# else
+#  ifdef NFDBITS
 
-#ifndef NBBY
-#define NBBY 8
-#endif
+#    ifndef NBBY
+#     define NBBY 8
+#    endif
 
     masksize = NFDBITS / NBBY;
-#else
+#  else
     masksize = sizeof(long);   /* documented int, everyone seems to use long */
-#endif
+#  endif
     growsize = maxlen + (masksize - (maxlen % masksize));
     Zero(&fd_sets[0], 4, char*);
 #endif
@@ -910,10 +1018,10 @@ PP(pp_getc)
     if (!gv)
        gv = PL_argvgv;
 
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
        I32 gimme = GIMME_V;
        PUSHMARK(SP);
-       XPUSHs(mg->mg_obj);
+       XPUSHs(SvTIED_obj((SV*)gv, mg));
        PUTBACK;
        ENTER;
        perl_call_method("GETC", gimme);
@@ -1128,7 +1236,7 @@ PP(pp_prtf)
     else
        gv = PL_defoutgv;
 
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
        if (MARK == ORIGMARK) {
            MEXTEND(SP, 1);
            ++MARK;
@@ -1136,7 +1244,7 @@ PP(pp_prtf)
            ++SP;
        }
        PUSHMARK(MARK - 1);
-       *MARK = mg->mg_obj;
+       *MARK = SvTIED_obj((SV*)gv, mg);
        PUTBACK;
        ENTER;
        perl_call_method("PRINTF", G_SCALAR);
@@ -1240,12 +1348,12 @@ PP(pp_sysread)
 
     gv = (GV*)*++MARK;
     if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
-       SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
+       (mg = SvTIED_mg((SV*)gv, 'q')))
     {
        SV *sv;
        
        PUSHMARK(MARK-1);
-       *MARK = mg->mg_obj;
+       *MARK = SvTIED_obj((SV*)gv, mg);
        ENTER;
        perl_call_method("READ", G_SCALAR);
        LEAVE;
@@ -1301,7 +1409,7 @@ PP(pp_sysread)
     }
 #else
     if (PL_op->op_type == OP_RECV)
-       DIE(no_sock_func, "recv");
+       DIE(PL_no_sock_func, "recv");
 #endif
     if (offset < 0) {
        if (-offset > blen)
@@ -1356,6 +1464,15 @@ PP(pp_sysread)
 
 PP(pp_syswrite)
 {
+    djSP;
+    int items = (SP - PL_stack_base) - TOPMARK;
+    if (items == 2) {
+       SV *sv;
+        EXTEND(SP, 1);
+       sv = sv_2mortal(newSViv(sv_len(*SP)));
+       PUSHs(sv);
+        PUTBACK;
+    }
     return pp_send(ARGS);
 }
 
@@ -1372,13 +1489,11 @@ PP(pp_send)
     MAGIC *mg;
 
     gv = (GV*)*++MARK;
-    if (PL_op->op_type == OP_SYSWRITE &&
-       SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
-    {
+    if (PL_op->op_type == OP_SYSWRITE && (mg = SvTIED_mg((SV*)gv, 'q'))) {
        SV *sv;
        
        PUSHMARK(MARK-1);
-       *MARK = mg->mg_obj;
+       *MARK = SvTIED_obj((SV*)gv, mg);
        ENTER;
        perl_call_method("WRITE", G_SCALAR);
        LEAVE;
@@ -1434,7 +1549,7 @@ PP(pp_send)
 
 #else
     else
-       DIE(no_sock_func, "send");
+       DIE(PL_no_sock_func, "send");
 #endif
     if (length < 0)
        goto say_undef;
@@ -1488,13 +1603,13 @@ PP(pp_sysseek)
     djSP;
     GV *gv;
     int whence = POPi;
-    long offset = POPl;
+    Off_t offset = POPl;
 
     gv = PL_last_in_gv = (GV*)POPs;
     if (PL_op->op_type == OP_SEEK)
        PUSHs(boolSV(do_seek(gv, offset, whence)));
     else {
-       long n = do_sysseek(gv, offset, whence);
+       Off_t n = do_sysseek(gv, offset, whence);
        PUSHs((n < 0) ? &PL_sv_undef
              : sv_2mortal(n ? newSViv((IV)n)
                           : newSVpv(zero_but_true, ZBTLEN)));
@@ -1625,7 +1740,7 @@ PP(pp_ioctl)
     if (SvPOK(argsv)) {
        if (s[SvCUR(argsv)] != 17)
            DIE("Possible memory corruption: %s overflowed 3rd argument",
-               op_name[optype]);
+               PL_op_name[optype]);
        s[SvCUR(argsv)] = 0;            /* put our null back */
        SvSETMAGIC(argsv);              /* Assume it has changed */
     }
@@ -1668,7 +1783,7 @@ PP(pp_flock)
     PUSHi(value);
     RETURN;
 #else
-    DIE(no_func, "flock()");
+    DIE(PL_no_func, "flock()");
 #endif
 }
 
@@ -1712,7 +1827,7 @@ PP(pp_socket)
 
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "socket");
+    DIE(PL_no_sock_func, "socket");
 #endif
 }
 
@@ -1762,7 +1877,7 @@ PP(pp_sockpair)
 
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "socketpair");
+    DIE(PL_no_sock_func, "socketpair");
 #endif
 }
 
@@ -1821,7 +1936,7 @@ nuts:
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
-    DIE(no_sock_func, "bind");
+    DIE(PL_no_sock_func, "bind");
 #endif
 }
 
@@ -1851,7 +1966,7 @@ nuts:
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
-    DIE(no_sock_func, "connect");
+    DIE(PL_no_sock_func, "connect");
 #endif
 }
 
@@ -1877,7 +1992,7 @@ nuts:
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
-    DIE(no_sock_func, "listen");
+    DIE(PL_no_sock_func, "listen");
 #endif
 }
 
@@ -1934,7 +2049,7 @@ badexit:
     RETPUSHUNDEF;
 
 #else
-    DIE(no_sock_func, "accept");
+    DIE(PL_no_sock_func, "accept");
 #endif
 }
 
@@ -1958,7 +2073,7 @@ nuts:
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
-    DIE(no_sock_func, "shutdown");
+    DIE(PL_no_sock_func, "shutdown");
 #endif
 }
 
@@ -1967,7 +2082,7 @@ PP(pp_gsockopt)
 #ifdef HAS_SOCKET
     return pp_ssockopt(ARGS);
 #else
-    DIE(no_sock_func, "getsockopt");
+    DIE(PL_no_sock_func, "getsockopt");
 #endif
 }
 
@@ -2038,7 +2153,7 @@ nuts2:
     RETPUSHUNDEF;
 
 #else
-    DIE(no_sock_func, "setsockopt");
+    DIE(PL_no_sock_func, "setsockopt");
 #endif
 }
 
@@ -2047,7 +2162,7 @@ PP(pp_getsockname)
 #ifdef HAS_SOCKET
     return pp_getpeername(ARGS);
 #else
-    DIE(no_sock_func, "getsockname");
+    DIE(PL_no_sock_func, "getsockname");
 #endif
 }
 
@@ -2111,7 +2226,7 @@ nuts2:
     RETPUSHUNDEF;
 
 #else
-    DIE(no_sock_func, "getpeername");
+    DIE(PL_no_sock_func, "getpeername");
 #endif
 }
 
@@ -2163,7 +2278,7 @@ PP(pp_stat)
            PL_laststatval = PerlLIO_stat(SvPV(PL_statname, PL_na), &PL_statcache);
        if (PL_laststatval < 0) {
            if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, PL_na), '\n'))
-               warner(WARN_NEWLINE, warn_nl, "stat");
+               warner(WARN_NEWLINE, PL_warn_nl, "stat");
            max = 0;
        }
     }
@@ -2211,8 +2326,23 @@ PP(pp_stat)
 
 PP(pp_ftrread)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#if defined(HAS_ACCESS) && defined(R_OK)
+    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+       result = access(TOPp, R_OK);
+       if (result == 0)
+           RETPUSHYES;
+       if (result < 0)
+           RETPUSHUNDEF;
+       RETPUSHNO;
+    }
+    else
+       result = my_stat(ARGS);
+#else
+    result = my_stat(ARGS);
+#endif
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (cando(S_IRUSR, 0, &PL_statcache))
@@ -2222,8 +2352,23 @@ PP(pp_ftrread)
 
 PP(pp_ftrwrite)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#if defined(HAS_ACCESS) && defined(W_OK)
+    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+       result = access(TOPp, W_OK);
+       if (result == 0)
+           RETPUSHYES;
+       if (result < 0)
+           RETPUSHUNDEF;
+       RETPUSHNO;
+    }
+    else
+       result = my_stat(ARGS);
+#else
+    result = my_stat(ARGS);
+#endif
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (cando(S_IWUSR, 0, &PL_statcache))
@@ -2233,8 +2378,23 @@ PP(pp_ftrwrite)
 
 PP(pp_ftrexec)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#if defined(HAS_ACCESS) && defined(X_OK)
+    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+       result = access(TOPp, X_OK);
+       if (result == 0)
+           RETPUSHYES;
+       if (result < 0)
+           RETPUSHUNDEF;
+       RETPUSHNO;
+    }
+    else
+       result = my_stat(ARGS);
+#else
+    result = my_stat(ARGS);
+#endif
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (cando(S_IXUSR, 0, &PL_statcache))
@@ -2244,8 +2404,23 @@ PP(pp_ftrexec)
 
 PP(pp_fteread)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#ifdef PERL_EFF_ACCESS_R_OK
+    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+       result = PERL_EFF_ACCESS_R_OK(TOPp);
+       if (result == 0)
+           RETPUSHYES;
+       if (result < 0)
+           RETPUSHUNDEF;
+       RETPUSHNO;
+    }
+    else
+       result = my_stat(ARGS);
+#else
+    result = my_stat(ARGS);
+#endif
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (cando(S_IRUSR, 1, &PL_statcache))
@@ -2255,8 +2430,23 @@ PP(pp_fteread)
 
 PP(pp_ftewrite)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#ifdef PERL_EFF_ACCESS_W_OK
+    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+       result = PERL_EFF_ACCESS_W_OK(TOPp);
+       if (result == 0)
+           RETPUSHYES;
+       if (result < 0)
+           RETPUSHUNDEF;
+       RETPUSHNO;
+    }
+    else
+       result = my_stat(ARGS);
+#else
+    result = my_stat(ARGS);
+#endif
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (cando(S_IWUSR, 1, &PL_statcache))
@@ -2266,8 +2456,23 @@ PP(pp_ftewrite)
 
 PP(pp_fteexec)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#ifdef PERL_EFF_ACCESS_X_OK
+    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+       result = PERL_EFF_ACCESS_X_OK(TOPp);
+       if (result == 0)
+           RETPUSHYES;
+       if (result < 0)
+           RETPUSHUNDEF;
+       RETPUSHNO;
+    }
+    else
+       result = my_stat(ARGS);
+#else
+    result = my_stat(ARGS);
+#endif
+    SPAGAIN;
     if (result < 0)
        RETPUSHUNDEF;
     if (cando(S_IXUSR, 1, &PL_statcache))
@@ -2587,7 +2792,7 @@ PP(pp_fttext)
 #endif
        if (i < 0) {
            if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, PL_na), '\n'))
-               warner(WARN_NEWLINE, warn_nl, "open");
+               warner(WARN_NEWLINE, PL_warn_nl, "open");
            RETPUSHUNDEF;
        }
        PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
@@ -2684,7 +2889,7 @@ PP(pp_chown)
     PUSHi(value);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function chown");
+    DIE(PL_no_func, "Unsupported function chown");
 #endif
 }
 
@@ -2698,7 +2903,7 @@ PP(pp_chroot)
     PUSHi( chroot(tmps) >= 0 );
     RETURN;
 #else
-    DIE(no_func, "chroot");
+    DIE(PL_no_func, "chroot");
 #endif
 }
 
@@ -2767,7 +2972,7 @@ PP(pp_link)
     TAINT_PROPER("link");
     SETi( link(tmps, tmps2) >= 0 );
 #else
-    DIE(no_func, "Unsupported function link");
+    DIE(PL_no_func, "Unsupported function link");
 #endif
     RETURN;
 }
@@ -2782,7 +2987,7 @@ PP(pp_symlink)
     SETi( symlink(tmps, tmps2) >= 0 );
     RETURN;
 #else
-    DIE(no_func, "symlink");
+    DIE(PL_no_func, "symlink");
 #endif
 }
 
@@ -2959,7 +3164,7 @@ nope:
        SETERRNO(EBADF,RMS$_DIR);
     RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "opendir");
+    DIE(PL_no_dir_func, "opendir");
 #endif
 }
 
@@ -3015,7 +3220,7 @@ nope:
     else
        RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "readdir");
+    DIE(PL_no_dir_func, "readdir");
 #endif
 }
 
@@ -3039,7 +3244,7 @@ nope:
        SETERRNO(EBADF,RMS$_ISI);
     RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "telldir");
+    DIE(PL_no_dir_func, "telldir");
 #endif
 }
 
@@ -3062,7 +3267,7 @@ nope:
        SETERRNO(EBADF,RMS$_ISI);
     RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "seekdir");
+    DIE(PL_no_dir_func, "seekdir");
 #endif
 }
 
@@ -3083,7 +3288,7 @@ nope:
        SETERRNO(EBADF,RMS$_ISI);
     RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "rewinddir");
+    DIE(PL_no_dir_func, "rewinddir");
 #endif
 }
 
@@ -3113,7 +3318,7 @@ nope:
        SETERRNO(EBADF,RMS$_IFI);
     RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "closedir");
+    DIE(PL_no_dir_func, "closedir");
 #endif
 }
 
@@ -3139,7 +3344,7 @@ PP(pp_fork)
     PUSHi(childpid);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function fork");
+    DIE(PL_no_func, "Unsupported function fork");
 #endif
 }
 
@@ -3155,7 +3360,7 @@ PP(pp_wait)
     XPUSHi(childpid);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function wait");
+    DIE(PL_no_func, "Unsupported function wait");
 #endif
 }
 
@@ -3174,7 +3379,7 @@ PP(pp_waitpid)
     SETi(childpid);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function waitpid");
+    DIE(PL_no_func, "Unsupported function waitpid");
 #endif
 }
 
@@ -3259,7 +3464,14 @@ PP(pp_exec)
 #ifdef VMS
        value = (I32)vms_do_aexec(Nullsv, MARK, SP);
 #else
+#  ifdef __OPEN_VM
+       {
+          (void ) do_aspawn(Nullsv, MARK, SP);
+          value = 0;
+       }
+#  else
        value = (I32)do_aexec(Nullsv, MARK, SP);
+#  endif
 #endif
     else {
        if (PL_tainting) {
@@ -3270,7 +3482,12 @@ PP(pp_exec)
 #ifdef VMS
        value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
 #else
+#  ifdef __OPEN_VM
+       (void) do_spawn(SvPVx(sv_mortalcopy(*SP), PL_na));
+       value = 0;
+#  else
        value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
+#  endif
 #endif
     }
     SP = ORIGMARK;
@@ -3288,7 +3505,7 @@ PP(pp_kill)
     PUSHi(value);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function kill");
+    DIE(PL_no_func, "Unsupported function kill");
 #endif
 }
 
@@ -3299,7 +3516,7 @@ PP(pp_getppid)
     XPUSHi( getppid() );
     RETURN;
 #else
-    DIE(no_func, "getppid");
+    DIE(PL_no_func, "getppid");
 #endif
 }
 
@@ -3324,7 +3541,7 @@ PP(pp_getpgrp)
     XPUSHi(value);
     RETURN;
 #else
-    DIE(no_func, "getpgrp()");
+    DIE(PL_no_func, "getpgrp()");
 #endif
 }
 
@@ -3353,7 +3570,7 @@ PP(pp_setpgrp)
 #endif /* USE_BSDPGRP */
     RETURN;
 #else
-    DIE(no_func, "setpgrp()");
+    DIE(PL_no_func, "setpgrp()");
 #endif
 }
 
@@ -3368,7 +3585,7 @@ PP(pp_getpriority)
     SETi( getpriority(which, who) );
     RETURN;
 #else
-    DIE(no_func, "getpriority()");
+    DIE(PL_no_func, "getpriority()");
 #endif
 }
 
@@ -3386,7 +3603,7 @@ PP(pp_setpriority)
     SETi( setpriority(which, who, niceval) >= 0 );
     RETURN;
 #else
-    DIE(no_func, "setpriority()");
+    DIE(PL_no_func, "setpriority()");
 #endif
 }
 
@@ -3518,7 +3735,7 @@ PP(pp_alarm)
     PUSHi((I32)anum);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function alarm");
+    DIE(PL_no_func, "Unsupported function alarm");
 #endif
 }
 
@@ -3666,7 +3883,7 @@ PP(pp_ghbyname)
 #ifdef HAS_GETHOSTBYNAME
     return pp_ghostent(ARGS);
 #else
-    DIE(no_sock_func, "gethostbyname");
+    DIE(PL_no_sock_func, "gethostbyname");
 #endif
 }
 
@@ -3675,7 +3892,7 @@ PP(pp_ghbyaddr)
 #ifdef HAS_GETHOSTBYADDR
     return pp_ghostent(ARGS);
 #else
-    DIE(no_sock_func, "gethostbyaddr");
+    DIE(PL_no_sock_func, "gethostbyaddr");
 #endif
 }
 
@@ -3699,7 +3916,7 @@ PP(pp_ghostent)
 #ifdef HAS_GETHOSTBYNAME
        hent = PerlSock_gethostbyname(POPp);
 #else
-       DIE(no_sock_func, "gethostbyname");
+       DIE(PL_no_sock_func, "gethostbyname");
 #endif
     else if (which == OP_GHBYADDR) {
 #ifdef HAS_GETHOSTBYADDR
@@ -3710,14 +3927,14 @@ PP(pp_ghostent)
 
        hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
 #else
-       DIE(no_sock_func, "gethostbyaddr");
+       DIE(PL_no_sock_func, "gethostbyaddr");
 #endif
     }
     else
 #ifdef HAS_GETHOSTENT
        hent = PerlSock_gethostent();
 #else
-       DIE(no_sock_func, "gethostent");
+       DIE(PL_no_sock_func, "gethostent");
 #endif
 
 #ifdef HOST_NOT_FOUND
@@ -3765,7 +3982,7 @@ PP(pp_ghostent)
     }
     RETURN;
 #else
-    DIE(no_sock_func, "gethostent");
+    DIE(PL_no_sock_func, "gethostent");
 #endif
 }
 
@@ -3774,7 +3991,7 @@ PP(pp_gnbyname)
 #ifdef HAS_GETNETBYNAME
     return pp_gnetent(ARGS);
 #else
-    DIE(no_sock_func, "getnetbyname");
+    DIE(PL_no_sock_func, "getnetbyname");
 #endif
 }
 
@@ -3783,7 +4000,7 @@ PP(pp_gnbyaddr)
 #ifdef HAS_GETNETBYADDR
     return pp_gnetent(ARGS);
 #else
-    DIE(no_sock_func, "getnetbyaddr");
+    DIE(PL_no_sock_func, "getnetbyaddr");
 #endif
 }
 
@@ -3805,7 +4022,7 @@ PP(pp_gnetent)
 #ifdef HAS_GETNETBYNAME
        nent = PerlSock_getnetbyname(POPp);
 #else
-        DIE(no_sock_func, "getnetbyname");
+        DIE(PL_no_sock_func, "getnetbyname");
 #endif
     else if (which == OP_GNBYADDR) {
 #ifdef HAS_GETNETBYADDR
@@ -3813,14 +4030,14 @@ PP(pp_gnetent)
        Netdb_net_t addr = (Netdb_net_t) U_L(POPn);
        nent = PerlSock_getnetbyaddr(addr, addrtype);
 #else
-       DIE(no_sock_func, "getnetbyaddr");
+       DIE(PL_no_sock_func, "getnetbyaddr");
 #endif
     }
     else
 #ifdef HAS_GETNETENT
        nent = PerlSock_getnetent();
 #else
-        DIE(no_sock_func, "getnetent");
+        DIE(PL_no_sock_func, "getnetent");
 #endif
 
     EXTEND(SP, 4);
@@ -3852,7 +4069,7 @@ PP(pp_gnetent)
 
     RETURN;
 #else
-    DIE(no_sock_func, "getnetent");
+    DIE(PL_no_sock_func, "getnetent");
 #endif
 }
 
@@ -3861,7 +4078,7 @@ PP(pp_gpbyname)
 #ifdef HAS_GETPROTOBYNAME
     return pp_gprotoent(ARGS);
 #else
-    DIE(no_sock_func, "getprotobyname");
+    DIE(PL_no_sock_func, "getprotobyname");
 #endif
 }
 
@@ -3870,7 +4087,7 @@ PP(pp_gpbynumber)
 #ifdef HAS_GETPROTOBYNUMBER
     return pp_gprotoent(ARGS);
 #else
-    DIE(no_sock_func, "getprotobynumber");
+    DIE(PL_no_sock_func, "getprotobynumber");
 #endif
 }
 
@@ -3892,19 +4109,19 @@ PP(pp_gprotoent)
 #ifdef HAS_GETPROTOBYNAME
        pent = PerlSock_getprotobyname(POPp);
 #else
-       DIE(no_sock_func, "getprotobyname");
+       DIE(PL_no_sock_func, "getprotobyname");
 #endif
     else if (which == OP_GPBYNUMBER)
 #ifdef HAS_GETPROTOBYNUMBER
        pent = PerlSock_getprotobynumber(POPi);
 #else
-    DIE(no_sock_func, "getprotobynumber");
+    DIE(PL_no_sock_func, "getprotobynumber");
 #endif
     else
 #ifdef HAS_GETPROTOENT
        pent = PerlSock_getprotoent();
 #else
-       DIE(no_sock_func, "getprotoent");
+       DIE(PL_no_sock_func, "getprotoent");
 #endif
 
     EXTEND(SP, 3);
@@ -3934,7 +4151,7 @@ PP(pp_gprotoent)
 
     RETURN;
 #else
-    DIE(no_sock_func, "getprotoent");
+    DIE(PL_no_sock_func, "getprotoent");
 #endif
 }
 
@@ -3943,7 +4160,7 @@ PP(pp_gsbyname)
 #ifdef HAS_GETSERVBYNAME
     return pp_gservent(ARGS);
 #else
-    DIE(no_sock_func, "getservbyname");
+    DIE(PL_no_sock_func, "getservbyname");
 #endif
 }
 
@@ -3952,7 +4169,7 @@ PP(pp_gsbyport)
 #ifdef HAS_GETSERVBYPORT
     return pp_gservent(ARGS);
 #else
-    DIE(no_sock_func, "getservbyport");
+    DIE(PL_no_sock_func, "getservbyport");
 #endif
 }
 
@@ -3980,7 +4197,7 @@ PP(pp_gservent)
 
        sent = PerlSock_getservbyname(name, proto);
 #else
-       DIE(no_sock_func, "getservbyname");
+       DIE(PL_no_sock_func, "getservbyname");
 #endif
     }
     else if (which == OP_GSBYPORT) {
@@ -3993,14 +4210,14 @@ PP(pp_gservent)
 #endif
        sent = PerlSock_getservbyport(port, proto);
 #else
-       DIE(no_sock_func, "getservbyport");
+       DIE(PL_no_sock_func, "getservbyport");
 #endif
     }
     else
 #ifdef HAS_GETSERVENT
        sent = PerlSock_getservent();
 #else
-       DIE(no_sock_func, "getservent");
+       DIE(PL_no_sock_func, "getservent");
 #endif
 
     EXTEND(SP, 4);
@@ -4041,7 +4258,7 @@ PP(pp_gservent)
 
     RETURN;
 #else
-    DIE(no_sock_func, "getservent");
+    DIE(PL_no_sock_func, "getservent");
 #endif
 }
 
@@ -4052,7 +4269,7 @@ PP(pp_shostent)
     PerlSock_sethostent(TOPi);
     RETSETYES;
 #else
-    DIE(no_sock_func, "sethostent");
+    DIE(PL_no_sock_func, "sethostent");
 #endif
 }
 
@@ -4063,7 +4280,7 @@ PP(pp_snetent)
     PerlSock_setnetent(TOPi);
     RETSETYES;
 #else
-    DIE(no_sock_func, "setnetent");
+    DIE(PL_no_sock_func, "setnetent");
 #endif
 }
 
@@ -4074,7 +4291,7 @@ PP(pp_sprotoent)
     PerlSock_setprotoent(TOPi);
     RETSETYES;
 #else
-    DIE(no_sock_func, "setprotoent");
+    DIE(PL_no_sock_func, "setprotoent");
 #endif
 }
 
@@ -4085,7 +4302,7 @@ PP(pp_sservent)
     PerlSock_setservent(TOPi);
     RETSETYES;
 #else
-    DIE(no_sock_func, "setservent");
+    DIE(PL_no_sock_func, "setservent");
 #endif
 }
 
@@ -4097,7 +4314,7 @@ PP(pp_ehostent)
     EXTEND(SP,1);
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "endhostent");
+    DIE(PL_no_sock_func, "endhostent");
 #endif
 }
 
@@ -4109,7 +4326,7 @@ PP(pp_enetent)
     EXTEND(SP,1);
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "endnetent");
+    DIE(PL_no_sock_func, "endnetent");
 #endif
 }
 
@@ -4121,7 +4338,7 @@ PP(pp_eprotoent)
     EXTEND(SP,1);
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "endprotoent");
+    DIE(PL_no_sock_func, "endprotoent");
 #endif
 }
 
@@ -4133,7 +4350,7 @@ PP(pp_eservent)
     EXTEND(SP,1);
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "endservent");
+    DIE(PL_no_sock_func, "endservent");
 #endif
 }
 
@@ -4142,7 +4359,7 @@ PP(pp_gpwnam)
 #ifdef HAS_PASSWD
     return pp_gpwent(ARGS);
 #else
-    DIE(no_func, "getpwnam");
+    DIE(PL_no_func, "getpwnam");
 #endif
 }
 
@@ -4151,7 +4368,7 @@ PP(pp_gpwuid)
 #ifdef HAS_PASSWD
     return pp_gpwent(ARGS);
 #else
-    DIE(no_func, "getpwuid");
+    DIE(PL_no_func, "getpwuid");
 #endif
 }
 
@@ -4243,7 +4460,7 @@ PP(pp_gpwent)
     }
     RETURN;
 #else
-    DIE(no_func, "getpwent");
+    DIE(PL_no_func, "getpwent");
 #endif
 }
 
@@ -4254,7 +4471,7 @@ PP(pp_spwent)
     setpwent();
     RETPUSHYES;
 #else
-    DIE(no_func, "setpwent");
+    DIE(PL_no_func, "setpwent");
 #endif
 }
 
@@ -4265,7 +4482,7 @@ PP(pp_epwent)
     endpwent();
     RETPUSHYES;
 #else
-    DIE(no_func, "endpwent");
+    DIE(PL_no_func, "endpwent");
 #endif
 }
 
@@ -4274,7 +4491,7 @@ PP(pp_ggrnam)
 #ifdef HAS_GROUP
     return pp_ggrent(ARGS);
 #else
-    DIE(no_func, "getgrnam");
+    DIE(PL_no_func, "getgrnam");
 #endif
 }
 
@@ -4283,7 +4500,7 @@ PP(pp_ggrgid)
 #ifdef HAS_GROUP
     return pp_ggrent(ARGS);
 #else
-    DIE(no_func, "getgrgid");
+    DIE(PL_no_func, "getgrgid");
 #endif
 }
 
@@ -4337,7 +4554,7 @@ PP(pp_ggrent)
 
     RETURN;
 #else
-    DIE(no_func, "getgrent");
+    DIE(PL_no_func, "getgrent");
 #endif
 }
 
@@ -4348,7 +4565,7 @@ PP(pp_sgrent)
     setgrent();
     RETPUSHYES;
 #else
-    DIE(no_func, "setgrent");
+    DIE(PL_no_func, "setgrent");
 #endif
 }
 
@@ -4359,7 +4576,7 @@ PP(pp_egrent)
     endgrent();
     RETPUSHYES;
 #else
-    DIE(no_func, "endgrent");
+    DIE(PL_no_func, "endgrent");
 #endif
 }
 
@@ -4374,7 +4591,7 @@ PP(pp_getlogin)
     PUSHp(tmps, strlen(tmps));
     RETURN;
 #else
-    DIE(no_func, "getlogin");
+    DIE(PL_no_func, "getlogin");
 #endif
 }
 
@@ -4473,7 +4690,7 @@ PP(pp_syscall)
     PUSHi(retval);
     RETURN;
 #else
-    DIE(no_func, "syscall");
+    DIE(PL_no_func, "syscall");
 #endif
 }