Integrate:

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

diff --git a/pp_sys.c b/pp_sys.c
index 6de068f..22bc18c 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.
@@ -762,7 +762,6 @@ PP(pp_tie)
     char *methname;
     int how = PERL_MAGIC_tied;
     U32 items;
-    STRLEN n_a;
 
     varsv = *++MARK;
     switch(SvTYPE(varsv)) {
@@ -809,8 +808,8 @@ PP(pp_tie)
         */
        stash = gv_stashsv(*MARK, FALSE);
        if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
-           DIE(aTHX_ "Can't locate object method \"%s\" via package \"%s\"",
-                methname, SvPV(*MARK,n_a));
+           DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
+                methname, *MARK);
        }
        ENTER;
        PUSHSTACKi(PERLSI_MAGIC);
@@ -2032,22 +2031,31 @@ PP(pp_truncate)
         STRLEN n_a;
        int result = 1;
        GV *tmpgv;
-       
+       IO *io;
+
        if (PL_op->op_flags & OPf_SPECIAL) {
            tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
 
-       do_ftruncate:
-           TAINT_PROPER("truncate");
-           if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)))
-               result = 0;
+       do_ftruncate_gv:
+           if (!GvIO(tmpgv))
+               result = 0;
            else {
-               PerlIO_flush(IoIFP(GvIOp(tmpgv)));
+               PerlIO *fp;
+               io = GvIOp(tmpgv);
+           do_ftruncate_io:
+               TAINT_PROPER("truncate");
+               if (!(fp = IoIFP(io))) {
+                   result = 0;
+               }
+               else {
+                   PerlIO_flush(fp);
 #ifdef HAS_TRUNCATE
-               if (ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+                   if (ftruncate(PerlIO_fileno(fp), len) < 0)
 #else
-               if (my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+                   if (my_chsize(PerlIO_fileno(fp), len) < 0)
 #endif
-                   result = 0;
+                       result = 0;
+               }
            }
        }
        else {
@@ -2056,11 +2064,15 @@ PP(pp_truncate)
        
            if (SvTYPE(sv) == SVt_PVGV) {
                tmpgv = (GV*)sv;                /* *main::FRED for example */
-               goto do_ftruncate;
+               goto do_ftruncate_gv;
            }
            else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
                tmpgv = (GV*) SvRV(sv); /* \*main::FRED for example */
-               goto do_ftruncate;
+               goto do_ftruncate_gv;
+           }
+           else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
+               io = (IO*) SvRV(sv); /* *main::FRED{IO} for example */
+               goto do_ftruncate_io;
            }
 
            name = SvPV(sv, n_a);
@@ -2456,7 +2468,6 @@ PP(pp_accept)
     struct sockaddr saddr;     /* use a struct to avoid alignment problems */
     Sock_size_t len = sizeof saddr;
     int fd;
-    int fd2;
 
     ggv = (GV*)POPs;
     ngv = (GV*)POPs;
@@ -2477,11 +2488,7 @@ PP(pp_accept)
     if (IoIFP(nstio))
        do_close(ngv, FALSE);
     IoIFP(nstio) = PerlIO_fdopen(fd, "r"PIPESOCK_MODE);
-    /* FIXME: we dup(fd) here so that refcounting of fd's does not inhibit
-       fclose of IoOFP's FILE * - and hence leak memory.
-       Special treatment of _this_ case of IoIFP != IoOFP seems wrong.
-     */
-    IoOFP(nstio) = PerlIO_fdopen(fd2 = PerlLIO_dup(fd), "w"PIPESOCK_MODE);
+    IoOFP(nstio) = PerlIO_fdopen(fd, "w"PIPESOCK_MODE);
     IoTYPE(nstio) = IoTYPE_SOCKET;
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
        if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
@@ -2491,7 +2498,6 @@ PP(pp_accept)
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     fcntl(fd, F_SETFD, fd > PL_maxsysfd);      /* ensure close-on-exec */
-    fcntl(fd2, F_SETFD, fd2 > PL_maxsysfd);    /* ensure close-on-exec */
 #endif
 
 #ifdef EPOC
@@ -3957,13 +3963,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);
@@ -3987,13 +3994,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);