[Patch Encode.xs] calculation of need overflows

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 771f913..f8764c7 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,6 +1,6 @@
 /*    pp_sys.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, 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.
@@ -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;
 }
@@ -2066,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;
@@ -2469,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;
@@ -2489,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));
@@ -2499,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
@@ -3410,7 +3418,7 @@ PP(pp_chdir)
                 deprecate("chdir('') or chdir(undef) as chdir()");
             tmps = SvPV(*svp, n_a);
         }
-        else {            
+        else {
             PUSHi(0);
             TAINT_PROPER("chdir");
             RETURN;
@@ -4029,7 +4037,7 @@ 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)
@@ -4075,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),
@@ -4312,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