better implementation of change#3326; open(local $foo,...) now

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

diff --git a/pp_sys.c b/pp_sys.c
index d5b7969..2f065ed 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -411,7 +411,7 @@ PP(pp_indread)
 
 PP(pp_rcatline)
 {
-    PL_last_in_gv = cGVOP;
+    PL_last_in_gv = cGVOP_gv;
     return do_readline();
 }
 
@@ -475,7 +475,7 @@ PP(pp_die)
                HV *stash = SvSTASH(SvRV(error));
                GV *gv = gv_fetchmethod(stash, "PROPAGATE");
                if (gv) {
-                   SV *file = sv_2mortal(newSVsv(CopFILESV(PL_curcop)));
+                   SV *file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
                    SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop)));
                    EXTEND(SP, 3);
                    PUSHMARK(SP);
@@ -1138,9 +1138,9 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
     SAVETMPS;
 
     push_return(retop);
-    PUSHBLOCK(cx, CXt_SUB, PL_stack_sp);
+    PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
     PUSHFORMAT(cx);
-    SAVESPTR(PL_curpad);
+    SAVEVPTR(PL_curpad);
     PL_curpad = AvARRAY((AV*)svp[1]);
 
     setdefout(gv);         /* locally select filehandle so $% et al work */
@@ -1592,10 +1592,10 @@ PP(pp_send)
     djSP; dMARK; dORIGMARK; dTARGET;
     GV *gv;
     IO *io;
-    int offset;
+    Off_t offset;
     SV *bufsv;
     char *buffer;
-    int length;
+    Off_t length;
     STRLEN blen;
     MAGIC *mg;
 
@@ -1618,7 +1618,11 @@ PP(pp_send)
        goto say_undef;
     bufsv = *++MARK;
     buffer = SvPV(bufsv, blen);
+#if Off_t_SIZE > IVSIZE
+    length = SvNVx(*++MARK);
+#else
     length = SvIVx(*++MARK);
+#endif
     if (length < 0)
        DIE(aTHX_ "Negative length");
     SETERRNO(0,0);
@@ -1634,7 +1638,11 @@ PP(pp_send)
     }
     else if (PL_op->op_type == OP_SYSWRITE) {
        if (MARK < SP) {
+#if Off_t_SIZE > IVSIZE
+           offset = SvNVx(*++MARK);
+#else
            offset = SvIVx(*++MARK);
+#endif
            if (offset < 0) {
                if (-offset > blen)
                    DIE(aTHX_ "Offset outside string");
@@ -1737,7 +1745,11 @@ PP(pp_tell)
        RETURN;
     }
 
+#if LSEEKSIZE > IVSIZE
+    PUSHn( do_tell(gv) );
+#else
     PUSHi( do_tell(gv) );
+#endif
     RETURN;
 }
 
@@ -1751,7 +1763,11 @@ PP(pp_sysseek)
     djSP;
     GV *gv;
     int whence = POPi;
+#if LSEEKSIZE > IVSIZE
+    Off_t offset = (Off_t)SvNVx(POPs);
+#else
     Off_t offset = (Off_t)SvIVx(POPs);
+#endif
     MAGIC *mg;
 
     gv = PL_last_in_gv = (GV*)POPs;
@@ -1773,9 +1789,18 @@ PP(pp_sysseek)
        PUSHs(boolSV(do_seek(gv, offset, whence)));
     else {
        Off_t n = do_sysseek(gv, offset, whence);
-       PUSHs((n < 0) ? &PL_sv_undef
-             : sv_2mortal(n ? newSViv((IV)n)
-                          : newSVpvn(zero_but_true, ZBTLEN)));
+        if (n < 0)
+            PUSHs(&PL_sv_undef);
+        else {
+            SV* sv = n ?
+#if LSEEKSIZE > IVSIZE
+                newSVnv((NV)n)
+#else
+                newSViv((IV)n)
+#endif
+                : newSVpvn(zero_but_true, ZBTLEN);
+            PUSHs(sv_2mortal(sv));
+        }
     }
     RETURN;
 }
@@ -2412,7 +2437,7 @@ PP(pp_stat)
     STRLEN n_a;
 
     if (PL_op->op_flags & OPf_REF) {
-       tmpgv = cGVOP;
+       tmpgv = cGVOP_gv;
       do_fstat:
        if (tmpgv != PL_defgv) {
            PL_laststype = OP_STAT;
@@ -2478,7 +2503,7 @@ PP(pp_stat)
 #else
        PUSHs(sv_2mortal(newSVpvn("", 0)));
 #endif
-#if Size_t_size > IVSIZE
+#if Off_t_size > IVSIZE
        PUSHs(sv_2mortal(newSVnv(PL_statcache.st_size)));
 #else
        PUSHs(sv_2mortal(newSViv(PL_statcache.st_size)));
@@ -2708,7 +2733,7 @@ PP(pp_ftsize)
     djSP; dTARGET;
     if (result < 0)
        RETPUSHUNDEF;
-#ifdef Size_t_size > IVSISE
+#if Off_t_size > IVSIZE
     PUSHn(PL_statcache.st_size);
 #else
     PUSHi(PL_statcache.st_size);
@@ -2874,7 +2899,7 @@ PP(pp_fttty)
     STRLEN n_a;
 
     if (PL_op->op_flags & OPf_REF)
-       gv = cGVOP;
+       gv = cGVOP_gv;
     else if (isGV(TOPs))
        gv = (GV*)POPs;
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
@@ -2916,7 +2941,7 @@ PP(pp_fttext)
     PerlIO *fp;
 
     if (PL_op->op_flags & OPf_REF)
-       gv = cGVOP;
+       gv = cGVOP_gv;
     else if (isGV(TOPs))
        gv = (GV*)POPs;
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
@@ -2965,9 +2990,11 @@ PP(pp_fttext)
                len = 512;
        }
        else {
-           if (ckWARN(WARN_UNOPENED))
+           if (ckWARN(WARN_UNOPENED)) {
+               gv = cGVOP_gv;
                Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>",
-                           GvENAME(cGVOP));
+                           GvENAME(gv));
+           }
            SETERRNO(EBADF,RMS$_IFI);
            RETPUSHUNDEF;
        }
@@ -3175,7 +3202,7 @@ PP(pp_link)
     char *tmps2 = POPpx;
     char *tmps = SvPV(TOPs, n_a);
     TAINT_PROPER("link");
-    SETi( link(tmps, tmps2) >= 0 );
+    SETi( PerlLIO_link(tmps, tmps2) >= 0 );
 #else
     DIE(aTHX_ PL_no_func, "Unsupported function link");
 #endif
@@ -3551,13 +3578,24 @@ PP(pp_fork)
     if (!childpid) {
        /*SUPPRESS 560*/
        if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
-           sv_setiv(GvSV(tmpgv), (IV)getpid());
+           sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
        hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
     }
     PUSHi(childpid);
     RETURN;
 #else
+#  if defined(USE_ITHREADS) && defined(WIN32)
+    djSP; dTARGET;
+    Pid_t childpid;
+
+    EXTEND(SP, 1);
+    PERL_FLUSHALL_FOR_CHILD;
+    childpid = PerlProc_fork();
+    PUSHi(childpid);
+    RETURN;
+#  else
     DIE(aTHX_ PL_no_func, "Unsupported function fork");
+#  endif
 #endif
 }
 
@@ -3743,6 +3781,12 @@ PP(pp_exec)
 #  endif
 #endif
     }
+
+#ifdef USE_ITHREADS
+    if (value >= 0)
+       my_exit(value);
+#endif
+
     SP = ORIGMARK;
     PUSHi(value);
     RETURN;
@@ -3787,7 +3831,7 @@ PP(pp_getpgrp)
 #ifdef BSD_GETPGRP
     pgrp = (I32)BSD_GETPGRP(pid);
 #else
-    if (pid != 0 && pid != getpid())
+    if (pid != 0 && pid != PerlProc_getpid())
        DIE(aTHX_ "POSIX getpgrp can't take an argument");
     pgrp = getpgrp();
 #endif
@@ -3817,8 +3861,11 @@ PP(pp_setpgrp)
 #ifdef BSD_SETPGRP
     SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
 #else
-    if ((pgrp != 0 && pgrp != getpid()) || (pid != 0 && pid != getpid()))
+    if ((pgrp != 0 && pgrp != PerlProc_getpid())
+       || (pid != 0 && pid != PerlProc_getpid()))
+    {
        DIE(aTHX_ "setpgrp can't take arguments");
+    }
     SETi( setpgrp() >= 0 );
 #endif /* USE_BSDPGRP */
     RETURN;