Upgrade to Encode 1.92.

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

diff --git a/pp_sys.c b/pp_sys.c
index b14dd77..877d0a0 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,6 +1,6 @@
 /*    pp_sys.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (c) 1991-2003, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -1068,12 +1068,23 @@ PP(pp_sselect)
 #endif
     }
 
+#ifdef PERL_IRIX5_SELECT_TIMEVAL_VOID_CAST
+    /* Can't make just the (void*) conditional because that would be
+     * cpp #if within cpp macro, and not all compilers like that. */
+    nfound = PerlSock_select(
+       maxlen * 8,
+       (Select_fd_set_t) fd_sets[1],
+       (Select_fd_set_t) fd_sets[2],
+       (Select_fd_set_t) fd_sets[3],
+       (void*) tbuf); /* Workaround for compiler bug. */
+#else
     nfound = PerlSock_select(
        maxlen * 8,
        (Select_fd_set_t) fd_sets[1],
        (Select_fd_set_t) fd_sets[2],
        (Select_fd_set_t) fd_sets[3],
        tbuf);
+#endif
     for (i = 1; i <= 3; i++) {
        if (fd_sets[i]) {
            sv = SP[i];
@@ -3658,6 +3669,26 @@ S_dooneliner(pTHX_ char *cmd, char *filename)
 }
 #endif
 
+/* This macro removes trailing slashes from a directory name.
+ * Different operating and file systems take differently to
+ * trailing slashes.  According to POSIX 1003.1 1996 Edition
+ * any number of trailing slashes should be allowed.
+ * Thusly we snip them away so that even non-conforming
+ * systems are happy.
+ * We should probably do this "filtering" for all
+ * the functions that expect (potentially) directory names:
+ * -d, chdir(), chmod(), chown(), chroot(), fcntl()?,
+ * (mkdir()), opendir(), rename(), rmdir(), stat(). --jhi */
+
+#define TRIMSLASHES(tmps,len,copy) (tmps) = SvPV(TOPs, (len)); \
+    if ((len) > 1 && (tmps)[(len)-1] == '/') { \
+       do { \
+           (len)--; \
+       } while ((len) > 1 && (tmps)[(len)-1] == '/'); \
+       (tmps) = savepvn((tmps), (len)); \
+       (copy) = TRUE; \
+    }
+
 PP(pp_mkdir)
 {
     dSP; dTARGET;
@@ -3674,22 +3705,7 @@ PP(pp_mkdir)
     else
        mode = 0777;
 
-    tmps = SvPV(TOPs, len);
-    /* Different operating and file systems take differently to
-     * trailing slashes.  According to POSIX 1003.1 1996 Edition
-     * any number of trailing slashes should be allowed.
-     * Thusly we snip them away so that even non-conforming
-     * systems are happy. */
-    /* We should probably do this "filtering" for all
-     * the functions that expect (potentially) directory names:
-     * -d, chdir(), chmod(), chown(), chroot(), fcntl()?,
-     * (mkdir()), opendir(), rename(), rmdir(), stat(). --jhi */
-    if (len > 1 && tmps[len-1] == '/') {
-       while (tmps[len-1] == '/' && len > 1)
-           len--;
-       tmps = savepvn(tmps, len);
-       copy = TRUE;
-    }
+    TRIMSLASHES(tmps,len,copy);
 
     TAINT_PROPER("mkdir");
 #ifdef HAS_MKDIR
@@ -3708,16 +3724,19 @@ PP(pp_mkdir)
 PP(pp_rmdir)
 {
     dSP; dTARGET;
+    STRLEN len;
     char *tmps;
-    STRLEN n_a;
+    bool copy = FALSE;
 
-    tmps = POPpx;
+    TRIMSLASHES(tmps,len,copy);
     TAINT_PROPER("rmdir");
 #ifdef HAS_RMDIR
-    XPUSHi( PerlDir_rmdir(tmps) >= 0 );
+    SETi( PerlDir_rmdir(tmps) >= 0 );
 #else
-    XPUSHi( dooneliner("rmdir", tmps) );
+    SETi( dooneliner("rmdir", tmps) );
 #endif
+    if (copy)
+       Safefree(tmps);
     RETURN;
 }
 
@@ -3963,13 +3982,14 @@ PP(pp_wait)
     Pid_t childpid;
     int argflags;
 
-#ifdef PERL_OLD_SIGNALS
-    childpid = wait4pid(-1, &argflags, 0);
-#else
-    while ((childpid = wait4pid(-1, &argflags, 0)) == -1 && errno == EINTR) {
-       PERL_ASYNC_CHECK();
+    if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
+        childpid = wait4pid(-1, &argflags, 0);
+    else {
+        while ((childpid = wait4pid(-1, &argflags, 0)) == -1 &&
+              errno == EINTR) {
+         PERL_ASYNC_CHECK();
+       }
     }
-#endif
 #  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
     /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
     STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
@@ -3993,13 +4013,14 @@ PP(pp_waitpid)
 
     optype = POPi;
     childpid = TOPi;
-#ifdef PERL_OLD_SIGNALS
-    childpid = wait4pid(childpid, &argflags, optype);
-#else
-    while ((childpid = wait4pid(childpid, &argflags, optype)) == -1 && errno == EINTR) {
-       PERL_ASYNC_CHECK();
+    if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
+        childpid = wait4pid(childpid, &argflags, optype);
+    else {
+        while ((childpid = wait4pid(childpid, &argflags, optype)) == -1 &&
+              errno == EINTR) {
+         PERL_ASYNC_CHECK();
+       }
     }
-#endif
 #  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
     /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
     STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);