Clean up and document API for hashes

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

diff --git a/pp_sys.c b/pp_sys.c
index 13e11b5..fbd5012 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -154,12 +154,13 @@ PP(pp_backtick)
     TAINT_PROPER("``");
     fp = my_popen(tmps, "r");
     if (fp) {
-       sv_setpv(TARG, "");     /* note that this preserves previous buffer */
        if (GIMME == G_SCALAR) {
+           sv_setpv(TARG, ""); /* note that this preserves previous buffer */
            while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
                /*SUPPRESS 530*/
                ;
            XPUSHs(TARG);
+           SvTAINTED_on(TARG);
        }
        else {
            SV *sv;
@@ -175,12 +176,14 @@ PP(pp_backtick)
                    SvLEN_set(sv, SvCUR(sv)+1);
                    Renew(SvPVX(sv), SvLEN(sv), char);
                }
+               SvTAINTED_on(sv);
            }
        }
-       statusvalue = FIXSTATUS(my_pclose(fp));
+       STATUS_NATIVE_SET(my_pclose(fp));
+       TAINT;          /* "I believe that this is not gratuitous!" */
     }
     else {
-       statusvalue = -1;
+       STATUS_NATIVE_SET(-1);
        if (GIMME == G_SCALAR)
            RETPUSHUNDEF;
     }
@@ -456,6 +459,7 @@ PP(pp_tie)
     SV **mark = stack_base + ++*markstack_ptr; /* reuse in entersub */
     I32 markoff = mark - stack_base - 1;
     char *methname;
+    bool oldmustcatch = mustcatch;
 
     varsv = mark[0];
     if (SvTYPE(varsv) == SVt_PVHV)
@@ -476,6 +480,7 @@ PP(pp_tie)
     myop.op_last = (OP *) &myop;
     myop.op_next = Nullop;
     myop.op_flags = OPf_KNOW|OPf_STACKED;
+    mustcatch = TRUE;
 
     ENTER;
     SAVESPTR(op);
@@ -490,6 +495,7 @@ PP(pp_tie)
         runops();
     SPAGAIN;
 
+    mustcatch = oldmustcatch;
     sv = TOPs;
     if (sv_isobject(sv)) {
        if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
@@ -523,8 +529,8 @@ PP(pp_untie)
                 mg = mg_find(sv, 'q') ;
     
             if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
-               warn("untie attempted while %d inner references still exist",
-                       SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
+               warn("untie attempted while %lu inner references still exist",
+                       (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
         }
     }
  
@@ -566,6 +572,7 @@ PP(pp_dbmopen)
     GV *gv;
     BINOP myop;
     SV *sv;
+    bool oldmustcatch = mustcatch;
 
     hv = (HV*)POPs;
 
@@ -584,6 +591,7 @@ PP(pp_dbmopen)
     myop.op_last = (OP *) &myop;
     myop.op_next = Nullop;
     myop.op_flags = OPf_KNOW|OPf_STACKED;
+    mustcatch = TRUE;
 
     ENTER;
     SAVESPTR(op);
@@ -626,6 +634,7 @@ PP(pp_dbmopen)
        SPAGAIN;
     }
 
+    mustcatch = oldmustcatch;
     if (sv_isobject(TOPs))
        sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
     LEAVE;
@@ -798,11 +807,13 @@ PP(pp_select)
        XPUSHs(&sv_undef);
     else {
        GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
-       if (gvp && *gvp == egv)
+       if (gvp && *gvp == egv) {
            gv_efullname3(TARG, defoutgv, Nullch);
-       else
-           sv_setsv(TARG, sv_2mortal(newRV((SV*)egv)));
-       XPUSHTARG;
+           XPUSHTARG;
+       }
+       else {
+           XPUSHs(sv_2mortal(newRV((SV*)egv)));
+       }
     }
 
     if (newdefout) {
@@ -889,7 +900,6 @@ PP(pp_enterwrite)
        fgv = gv;
 
     cv = GvFORM(fgv);
-
     if (!cv) {
        if (fgv) {
            SV *tmpsv = sv_newmortal();
@@ -898,8 +908,10 @@ PP(pp_enterwrite)
        }
        DIE("Not a format reference");
     }
-    IoFLAGS(io) &= ~IOf_DIDTOP;
+    if (CvCLONE(cv))
+       cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
 
+    IoFLAGS(io) &= ~IOf_DIDTOP;
     return doform(cv,gv,op->op_next);
 }
 
@@ -975,6 +987,8 @@ PP(pp_leavewrite)
            gv_efullname3(tmpsv, fgv, Nullch);
            DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
        }
+       if (CvCLONE(cv))
+           cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
        return doform(cv,gv,op);
     }
 
@@ -2847,12 +2861,12 @@ nope:
 
 PP(pp_fork)
 {
+#ifdef HAS_FORK
     dSP; dTARGET;
     int childpid;
     GV *tmpgv;
 
     EXTEND(SP, 1);
-#ifdef HAS_FORK
     childpid = fork();
     if (childpid < 0)
        RETSETUNDEF;
@@ -2871,19 +2885,14 @@ PP(pp_fork)
 
 PP(pp_wait)
 {
+#if !defined(DOSISH) || defined(OS2)
     dSP; dTARGET;
     int childpid;
     int argflags;
-    I32 value;
 
-    EXTEND(SP, 1);
-#ifdef HAS_WAIT
-    childpid = wait(&argflags);
-    if (childpid > 0)
-       pidgone(childpid, argflags);
-    value = (I32)childpid;
-    statusvalue = FIXSTATUS(argflags);
-    PUSHi(value);
+    childpid = wait4pid(-1, &argflags, 0);
+    STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+    XPUSHi(childpid);
     RETURN;
 #else
     DIE(no_func, "Unsupported function wait");
@@ -2892,19 +2901,17 @@ PP(pp_wait)
 
 PP(pp_waitpid)
 {
+#if !defined(DOSISH) || defined(OS2)
     dSP; dTARGET;
     int childpid;
     int optype;
     int argflags;
-    I32 value;
 
-#ifdef HAS_WAIT
     optype = POPi;
     childpid = TOPi;
     childpid = wait4pid(childpid, &argflags, optype);
-    value = (I32)childpid;
-    statusvalue = FIXSTATUS(argflags);
-    SETi(value);
+    STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+    SETi(childpid);
     RETURN;
 #else
     DIE(no_func, "Unsupported function wait");
@@ -2945,15 +2952,10 @@ PP(pp_system)
        } while (result == -1 && errno == EINTR);
        (void)rsignal_restore(SIGINT, &ihand);
        (void)rsignal_restore(SIGQUIT, &qhand);
-       statusvalue = FIXSTATUS(status);
-       if (result < 0)
-           value = -1;
-       else {
-           value = (I32)((unsigned int)status & 0xffff);
-       }
+       STATUS_NATIVE_SET(result == -1 ? -1 : status);
        do_execfree();  /* free any memory child malloced on vfork */
        SP = ORIGMARK;
-       PUSHi(value);
+       PUSHi(STATUS_CURRENT);
        RETURN;
     }
     if (op->op_flags & OPf_STACKED) {
@@ -2976,10 +2978,10 @@ PP(pp_system)
     else {
        value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
     }
-    statusvalue = FIXSTATUS(value);
+    STATUS_NATIVE_SET(value);
     do_execfree();
     SP = ORIGMARK;
-    PUSHi(value);
+    PUSHi(STATUS_CURRENT);
 #endif /* !FORK or VMS */
     RETURN;
 }
@@ -3055,7 +3057,7 @@ PP(pp_getpgrp)
 #ifdef BSD_GETPGRP
     value = (I32)BSD_GETPGRP(pid);
 #else
-    if (pid != 0)
+    if (pid != 0 && pid != getpid())
        DIE("POSIX getpgrp can't take an argument");
     value = (I32)getpgrp();
 #endif
@@ -3085,9 +3087,8 @@ PP(pp_setpgrp)
 #ifdef BSD_SETPGRP
     SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
 #else
-    if ((pgrp != 0) || (pid != 0)) {
+    if ((pgrp != 0 && pgrp != getpid())) || (pid != 0 && pid != getpid()))
        DIE("POSIX setpgrp can't take an argument");
-    }
     SETi( setpgrp() >= 0 );
 #endif /* USE_BSDPGRP */
     RETURN;
@@ -3454,7 +3455,7 @@ PP(pp_ghostent)
 
 #ifdef HOST_NOT_FOUND
     if (!hent)
-       statusvalue = FIXSTATUS(h_errno);
+       STATUS_NATIVE_SET(h_errno);
 #endif
 
     if (GIMME != G_ARRAY) {