Correct module name in perldelta*

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 2ec8191..99f1eb5 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -838,24 +838,26 @@ PP(pp_untie)
        SV *obj = SvRV(mg->mg_obj);
        GV *gv;
        CV *cv = NULL;
-       if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
-            isGV(gv) && (cv = GvCV(gv))) {
-           PUSHMARK(SP);
-           XPUSHs(SvTIED_obj((SV*)gv, mg));
-           XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
-           PUTBACK;
-           ENTER;
-           call_sv((SV *)cv, G_VOID);
-           LEAVE;
-           SPAGAIN;
-        }
-        else if (ckWARN(WARN_UNTIE)) {
-           if (mg && SvREFCNT(obj) > 1)
-               Perl_warner(aTHX_ WARN_UNTIE,
-                   "untie attempted while %"UVuf" inner references still exist",
-                   (UV)SvREFCNT(obj) - 1 ) ;
+        if (obj) {
+           if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
+               isGV(gv) && (cv = GvCV(gv))) {
+              PUSHMARK(SP);
+              XPUSHs(SvTIED_obj((SV*)gv, mg));
+              XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
+              PUTBACK;
+              ENTER;
+              call_sv((SV *)cv, G_VOID);
+              LEAVE;
+              SPAGAIN;
+            }
+           else if (ckWARN(WARN_UNTIE)) {
+              if (mg && SvREFCNT(obj) > 1)
+                 Perl_warner(aTHX_ WARN_UNTIE,
+                     "untie attempted while %"UVuf" inner references still exist",
+                      (UV)SvREFCNT(obj) - 1 ) ;
+           }
         }
-       sv_unmagic(sv, how);
+       sv_unmagic(sv, how) ;
     }
     RETPUSHYES;
 }
@@ -1518,8 +1520,8 @@ PP(pp_sysread)
     Size_t got = 0;
     Size_t wanted;
     bool charstart = FALSE;
-    STRLEN skip;
-    STRLEN charskip;
+    STRLEN charskip = 0;
+    STRLEN skip = 0;
 
     gv = (GV*)*++MARK;
     if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
@@ -1568,6 +1570,7 @@ PP(pp_sysread)
 
     charstart = TRUE;
     charskip  = 0;
+    skip = 0;
 
 #ifdef HAS_SOCKET
     if (PL_op->op_type == OP_RECV) {
@@ -1862,6 +1865,8 @@ PP(pp_send)
     if (retval < 0)
        goto say_undef;
     SP = ORIGMARK;
+    if (DO_UTF8(bufsv))
+        retval = utf8_length((U8*)buffer, (U8*)buffer + retval);
 #if Size_t_size > IVSIZE
     PUSHn(retval);
 #else
@@ -2063,7 +2068,7 @@ PP(pp_truncate)
        else {
            SV *sv = POPs;
            char *name;
-         
+       
            if (SvTYPE(sv) == SVt_PVGV) {
                tmpgv = (GV*)sv;                /* *main::FRED for example */
                goto do_ftruncate;
@@ -2277,7 +2282,7 @@ PP(pp_socket)
 
 PP(pp_sockpair)
 {
-#ifdef HAS_SOCKETPAIR
+#if defined (HAS_SOCKETPAIR) || defined (HAS_SOCKET)
     dSP;
     GV *gv1;
     GV *gv2;
@@ -2466,6 +2471,7 @@ 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;
@@ -2486,7 +2492,11 @@ PP(pp_accept)
     if (IoIFP(nstio))
        do_close(ngv, FALSE);
     IoIFP(nstio) = PerlIO_fdopen(fd, "r");
-    IoOFP(nstio) = PerlIO_fdopen(fd, "w");
+    /* 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");
     IoTYPE(nstio) = IoTYPE_SOCKET;
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
        if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
@@ -2496,6 +2506,7 @@ 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
@@ -3407,8 +3418,9 @@ PP(pp_chdir)
                 deprecate("chdir('') or chdir(undef) as chdir()");
             tmps = SvPV(*svp, n_a);
         }
-        else {            
+        else {
             PUSHi(0);
+            TAINT_PROPER("chdir");
             RETURN;
         }
     }
@@ -3510,9 +3522,8 @@ PP(pp_rename)
 
 PP(pp_link)
 {
-    dSP;
 #ifdef HAS_LINK
-    dTARGET;
+    dSP; dTARGET;
     STRLEN n_a;
     char *tmps2 = POPpx;
     char *tmps = SvPV(TOPs, n_a);
@@ -3920,8 +3931,11 @@ PP(pp_fork)
        RETSETUNDEF;
     if (!childpid) {
        /*SUPPRESS 560*/
-       if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV)))
+       if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV))) {
+            SvREADONLY_off(GvSV(tmpgv));
            sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
+            SvREADONLY_on(GvSV(tmpgv));
+        }
        hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
     }
     PUSHi(childpid);
@@ -4023,7 +4037,17 @@ PP(pp_system)
         Pid_t childpid;
         int status;
         Sigsave_t ihand,qhand;     /* place to save signals during system() */
-        
+       
+        if (PL_tainting) {
+            SV *cmd = NULL;
+            if (PL_op->op_flags & OPf_STACKED)
+               cmd = *(MARK + 1);
+            else if (SP - MARK != 1)
+               cmd = *SP;
+            if (cmd && *(SvPV_nolen(cmd)) != '/')
+               TAINT_ENV();
+        }
+
         if (PerlProc_pipe(pp) >= 0)
              did_pipes = 1;
         while ((childpid = PerlProc_fork()) == -1) {
@@ -4059,7 +4083,7 @@ PP(pp_system)
              if (did_pipes) {
                   int errkid;
                   int n = 0, n1;
-                  
+               
                   while (n < sizeof(int)) {
                        n1 = PerlLIO_read(pp[0],
                                          (void*)(((char*)&errkid)+n),
@@ -4296,6 +4320,10 @@ PP(pp_time)
    it's supported.    --AD  9/96.
 */
 
+#ifdef __BEOS__
+#  define HZ 1000000
+#endif
+
 #ifndef HZ
 #  ifdef CLK_TCK
 #    define HZ CLK_TCK