Avoid a pad panic by attempting to use dTARGET; in an op that didn't

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

diff --git a/doio.c b/doio.c
index 102a07a..c82740c 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -59,14 +59,6 @@
 #include <signal.h>
 
 bool
-Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
-            int rawmode, int rawperm, PerlIO *supplied_fp)
-{
-    return do_openn(gv, name, len, as_raw, rawmode, rawperm,
-                   supplied_fp, (SV **) NULL, 0);
-}
-
-bool
 Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
              I32 num_svs)
@@ -945,52 +937,6 @@ Perl_nextargv(pTHX_ register GV *gv)
     return Nullfp;
 }
 
-#ifdef HAS_PIPE
-void
-Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv)
-{
-    register IO *rstio;
-    register IO *wstio;
-    int fd[2];
-
-    if (!rgv)
-       goto badexit;
-    if (!wgv)
-       goto badexit;
-
-    rstio = GvIOn(rgv);
-    wstio = GvIOn(wgv);
-
-    if (IoIFP(rstio))
-       do_close(rgv,FALSE);
-    if (IoIFP(wstio))
-       do_close(wgv,FALSE);
-
-    if (PerlProc_pipe(fd) < 0)
-       goto badexit;
-    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE);
-    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE);
-    IoOFP(rstio) = IoIFP(rstio);
-    IoIFP(wstio) = IoOFP(wstio);
-    IoTYPE(rstio) = IoTYPE_RDONLY;
-    IoTYPE(wstio) = IoTYPE_WRONLY;
-    if (!IoIFP(rstio) || !IoOFP(wstio)) {
-       if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
-       else PerlLIO_close(fd[0]);
-       if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
-       else PerlLIO_close(fd[1]);
-       goto badexit;
-    }
-
-    sv_setsv(sv,&PL_sv_yes);
-    return;
-
-badexit:
-    sv_setsv(sv,&PL_sv_undef);
-    return;
-}
-#endif
-
 /* explicit renamed to avoid C++ conflict    -- kja */
 bool
 Perl_do_close(pTHX_ GV *gv, bool not_implicit)
@@ -1417,14 +1363,6 @@ Perl_my_lstat(pTHX)
     return PL_laststatval;
 }
 
-#ifndef OS2
-bool
-Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
-{
-    return do_aexec5(really, mark, sp, 0, 0);
-}
-#endif
-
 bool
 Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
               int fd, int do_report)
@@ -1481,13 +1419,7 @@ Perl_do_execfree(pTHX)
     PL_Cmd = Nullch;
 }
 
-#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL)
-
-bool
-Perl_do_exec(pTHX_ const char *cmd)
-{
-    return do_exec3(cmd,0,0);
-}
+#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
 
 bool
 Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
@@ -1834,12 +1766,15 @@ nothing in the core.
            }
        }
        break;
-#ifdef HAS_UTIME
+#if defined(HAS_UTIME) || defined(HAS_FUTIMES)
     case OP_UTIME:
        what = "utime";
        APPLY_TAINT_PROPER();
        if (sp - mark > 2) {
-#if defined(I_UTIME) || defined(VMS)
+#if defined(HAS_FUTIMES)
+           struct timeval utbuf[2];
+           void *utbufp = utbuf;
+#elif defined(I_UTIME) || defined(VMS)
            struct utimbuf utbuf;
            struct utimbuf *utbufp = &utbuf;
 #else
@@ -1861,7 +1796,12 @@ nothing in the core.
                 utbufp = NULL;
            else {
                 Zero(&utbuf, sizeof utbuf, char);
-#ifdef BIG_TIME
+#ifdef HAS_FUTIMES
+               utbuf[0].tv_sec = (long)SvIVx(accessed);  /* time accessed */
+               utbuf[0].tv_usec = 0;
+               utbuf[1].tv_sec = (long)SvIVx(modified);  /* time modified */
+               utbuf[1].tv_usec = 0;
+#elif defined(BIG_TIME)
                 utbuf.actime = (Time_t)SvNVx(accessed);  /* time accessed */
                 utbuf.modtime = (Time_t)SvNVx(modified); /* time modified */
 #else
@@ -1872,10 +1812,38 @@ nothing in the core.
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               char *name = SvPV_nolen(*mark);
-               APPLY_TAINT_PROPER();
-               if (PerlLIO_utime(name, utbufp))
-                   tot--;
+                GV* gv;
+                if (SvTYPE(*mark) == SVt_PVGV) {
+                    gv = (GV*)*mark;
+               do_futimes:
+                   if (GvIO(gv) && IoIFP(GvIOp(gv))) {
+#ifdef HAS_FUTIMES
+                       APPLY_TAINT_PROPER();
+                       if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), utbufp))
+                           tot--;
+#else
+                       Perl_die(aTHX_ PL_no_func, "futimes");
+#endif
+                   }
+                   else {
+                       tot--;
+                   }
+               }
+               else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) {
+                   gv = (GV*)SvRV(*mark);
+                   goto do_futimes;
+               }
+               else {
+                   const char *name = SvPV_nolen_const(*mark);
+                   APPLY_TAINT_PROPER();
+#ifdef HAS_FUTIMES
+                   if (utimes(name, utbufp))
+#else
+                   if (PerlLIO_utime(name, utbufp))
+#endif
+                       tot--;
+               }
+
            }
        }
        else