Bump the version to 5.7.2.

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

diff --git a/pp_sys.c b/pp_sys.c
index e9ba938..0451d5a 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -668,8 +668,8 @@ PP(pp_fileno)
 
 PP(pp_umask)
 {
-#ifdef HAS_UMASK
     dSP; dTARGET;
+#ifdef HAS_UMASK
     Mode_t anum;
 
     if (MAXARG < 1) {
@@ -699,8 +699,6 @@ PP(pp_binmode)
     PerlIO *fp;
     MAGIC *mg;
     SV *discp = Nullsv;
-    STRLEN len  = 0;
-    char *names = NULL;
 
     if (MAXARG < 1)
        RETPUSHUNDEF;
@@ -730,10 +728,6 @@ PP(pp_binmode)
         RETPUSHUNDEF;
     }
 
-    if (discp) {
-       names = SvPV(discp,len);
-    }
-
     if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
                        (discp) ? SvPV_nolen(discp) : Nullch))
        RETPUSHYES;
@@ -764,9 +758,9 @@ PP(pp_tie)
            methname = "TIEARRAY";
            break;
        case SVt_PVGV:
-#ifdef GV_SHARED_CHECK
-           if (GvSHARED((GV*)varsv)) {
-                Perl_croak(aTHX_ "Attempt to tie shared GV");
+#ifdef GV_UNIQUE_CHECK
+           if (GvUNIQUE((GV*)varsv)) {
+                Perl_croak(aTHX_ "Attempt to tie unique GV");
            }
 #endif
            methname = "TIEHANDLE";
@@ -3477,17 +3471,18 @@ PP(pp_rename)
 
 PP(pp_link)
 {
+    dSP;
 #ifdef HAS_LINK
-    dSP; dTARGET;
+    dTARGET;
     STRLEN n_a;
     char *tmps2 = POPpx;
     char *tmps = SvPV(TOPs, n_a);
     TAINT_PROPER("link");
     SETi( PerlLIO_link(tmps, tmps2) >= 0 );
+    RETURN;
 #else
     DIE(aTHX_ PL_no_func, "link");
 #endif
-    RETURN;
 }
 
 PP(pp_symlink)
@@ -3985,72 +3980,72 @@ PP(pp_system)
     }
     PERL_FLUSHALL_FOR_CHILD;
 #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
-  {
-    Pid_t childpid;
-    int status;
-    Sigsave_t ihand,qhand;     /* place to save signals during system() */
-
-    if (PerlProc_pipe(pp) >= 0)
-       did_pipes = 1;
-    while ((childpid = vfork()) == -1) {
-       if (errno != EAGAIN) {
-           value = -1;
-           SP = ORIGMARK;
-           PUSHi(value);
-           if (did_pipes) {
-               PerlLIO_close(pp[0]);
-               PerlLIO_close(pp[1]);
-           }
-           RETURN;
-       }
-       sleep(5);
-    }
-    if (childpid > 0) {
-       if (did_pipes)
-           PerlLIO_close(pp[1]);
+    {
+        Pid_t childpid;
+        int status;
+        Sigsave_t ihand,qhand;     /* place to save signals during system() */
+        
+        if (PerlProc_pipe(pp) >= 0)
+             did_pipes = 1;
+        while ((childpid = vfork()) == -1) {
+             if (errno != EAGAIN) {
+                  value = -1;
+                  SP = ORIGMARK;
+                  PUSHi(value);
+                  if (did_pipes) {
+                       PerlLIO_close(pp[0]);
+                       PerlLIO_close(pp[1]);
+                  }
+                  RETURN;
+             }
+             sleep(5);
+        }
+        if (childpid > 0) {
+             if (did_pipes)
+                  PerlLIO_close(pp[1]);
 #ifndef PERL_MICRO
-       rsignal_save(SIGINT, SIG_IGN, &ihand);
-       rsignal_save(SIGQUIT, SIG_IGN, &qhand);
+             rsignal_save(SIGINT, SIG_IGN, &ihand);
+             rsignal_save(SIGQUIT, SIG_IGN, &qhand);
 #endif
-       do {
-           result = wait4pid(childpid, &status, 0);
-       } while (result == -1 && errno == EINTR);
+             do {
+                  result = wait4pid(childpid, &status, 0);
+             } while (result == -1 && errno == EINTR);
 #ifndef PERL_MICRO
-       (void)rsignal_restore(SIGINT, &ihand);
-       (void)rsignal_restore(SIGQUIT, &qhand);
-#endif
-       STATUS_NATIVE_SET(result == -1 ? -1 : status);
-       do_execfree();  /* free any memory child malloced on vfork */
-       SP = ORIGMARK;
-       if (did_pipes) {
-           int errkid;
-           int n = 0, n1;
-
-           while (n < sizeof(int)) {
-               n1 = PerlLIO_read(pp[0],
-                                 (void*)(((char*)&errkid)+n),
-                                 (sizeof(int)) - n);
-               if (n1 <= 0)
-                   break;
-               n += n1;
-           }
-           PerlLIO_close(pp[0]);
-           if (n) {                    /* Error */
-               if (n != sizeof(int))
-                   DIE(aTHX_ "panic: kid popen errno read");
-               errno = errkid;         /* Propagate errno from kid */
-               STATUS_CURRENT = -1;
-           }
-       }
-       PUSHi(STATUS_CURRENT);
-       RETURN;
-    }
-    if (did_pipes) {
-       PerlLIO_close(pp[0]);
+             (void)rsignal_restore(SIGINT, &ihand);
+             (void)rsignal_restore(SIGQUIT, &qhand);
+#endif
+             STATUS_NATIVE_SET(result == -1 ? -1 : status);
+             do_execfree();    /* free any memory child malloced on vfork */
+             SP = ORIGMARK;
+             if (did_pipes) {
+                  int errkid;
+                  int n = 0, n1;
+                  
+                  while (n < sizeof(int)) {
+                       n1 = PerlLIO_read(pp[0],
+                                         (void*)(((char*)&errkid)+n),
+                                         (sizeof(int)) - n);
+                       if (n1 <= 0)
+                            break;
+                       n += n1;
+                  }
+                  PerlLIO_close(pp[0]);
+                  if (n) {                     /* Error */
+                       if (n != sizeof(int))
+                            DIE(aTHX_ "panic: kid popen errno read");
+                       errno = errkid;         /* Propagate errno from kid */
+                       STATUS_CURRENT = -1;
+                  }
+             }
+             PUSHi(STATUS_CURRENT);
+             RETURN;
+        }
+        if (did_pipes) {
+             PerlLIO_close(pp[0]);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-       fcntl(pp[1], F_SETFD, FD_CLOEXEC);
-  }
+             fcntl(pp[1], F_SETFD, FD_CLOEXEC);
 #endif
+        }
     }
     if (PL_op->op_flags & OPf_STACKED) {
        SV *really = *++MARK;
@@ -4126,11 +4121,6 @@ PP(pp_exec)
 #endif
     }
 
-#if !defined(HAS_FORK) && defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
-    if (value >= 0)
-       my_exit(value);
-#endif
-
     SP = ORIGMARK;
     PUSHi(value);
     RETURN;
@@ -4328,10 +4318,10 @@ PP(pp_gmtime)
     else
        tmbuf = gmtime(&when);
 
-    EXTEND(SP, 9);
-    EXTEND_MORTAL(9);
     if (GIMME != G_ARRAY) {
        SV *tsv;
+        EXTEND(SP, 1);
+        EXTEND_MORTAL(1);
        if (!tmbuf)
            RETPUSHUNDEF;
        tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d",
@@ -4345,7 +4335,9 @@ PP(pp_gmtime)
        PUSHs(sv_2mortal(tsv));
     }
     else if (tmbuf) {
-       PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
+        EXTEND(SP, 9);
+        EXTEND_MORTAL(9);
+        PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
        PUSHs(sv_2mortal(newSViv(tmbuf->tm_min)));
        PUSHs(sv_2mortal(newSViv(tmbuf->tm_hour)));
        PUSHs(sv_2mortal(newSViv(tmbuf->tm_mday)));