Compress::Zlib 1.35

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

diff --git a/pp_sys.c b/pp_sys.c
index b126647..77613cb 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -907,8 +907,7 @@ PP(pp_untie)
               LEAVE;
               SPAGAIN;
             }
-           else if (ckWARN(WARN_UNTIE)) {
-              if (mg && SvREFCNT(obj) > 1)
+           else if (mg && SvREFCNT(obj) > 1 && ckWARN(WARN_UNTIE)) {
                  Perl_warner(aTHX_ packWARN(WARN_UNTIE),
                      "untie attempted while %"UVuf" inner references still exist",
                       (UV)SvREFCNT(obj) - 1 ) ;
@@ -1232,8 +1231,8 @@ PP(pp_getc)
        RETURN;
     }
     if (!gv || do_eof(gv)) { /* make sure we have fp with something */
-       if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)
-               && (!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY)))
+       if ((!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY))
+         && ckWARN2(WARN_UNOPENED,WARN_CLOSED))
            report_evil_fh(gv, io, PL_op->op_type);
        SETERRNO(EBADF,RMS_IFI);
        RETPUSHUNDEF;
@@ -3543,19 +3542,30 @@ PP(pp_ftbinary)
 PP(pp_chdir)
 {
     dSP; dTARGET;
-    const char *tmps;
-    SV **svp;
+    const char *tmps = 0;
+    GV *gv = NULL;
 
-    if( MAXARG == 1 )
-        tmps = POPpconstx;
-    else
-        tmps = 0;
+    if( MAXARG == 1 ) {
+       SV * const sv = POPs;
+        if (SvTYPE(sv) == SVt_PVGV) {
+           gv = (GV*)sv;
+        }
+       else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+            gv = (GV*)SvRV(sv);
+        }
+        else {
+           tmps = SvPVx_nolen_const(sv);
+       }
+    }
 
-    if( !tmps || !*tmps ) {
-        if (    (svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE))
-             || (svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE))
+    if( !gv && (!tmps || !*tmps) ) {
+       HV * const table = GvHVn(PL_envgv);
+       SV **svp;
+
+        if (    (svp = hv_fetch(table, "HOME", 4, FALSE))
+             || (svp = hv_fetch(table, "LOGDIR", 6, FALSE))
 #ifdef VMS
-             || (svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE))
+             || (svp = hv_fetch(table, "SYS$LOGIN", 9, FALSE))
 #endif
            )
         {
@@ -3571,7 +3581,33 @@ PP(pp_chdir)
     }
 
     TAINT_PROPER("chdir");
-    PUSHi( PerlDir_chdir(tmps) >= 0 );
+    if (gv) {
+#ifdef HAS_FCHDIR
+       IO* const io = GvIO(gv);
+       if (io) {
+           if (IoIFP(io)) {
+               PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
+           }
+           else if (IoDIRP(io)) {
+#ifdef HAS_DIRFD
+               PUSHi(fchdir(dirfd(IoDIRP(io))) >= 0);
+#else
+               DIE(aTHX_ PL_no_func, "dirfd");
+#endif
+           }
+           else {
+               PUSHi(0);
+           }
+        }
+       else {
+           PUSHi(0);
+       }
+#else
+       DIE(aTHX_ PL_no_func, "fchdir");
+#endif
+    }
+    else 
+        PUSHi( PerlDir_chdir(tmps) >= 0 );
 #ifdef VMS
     /* Clear the DEFAULT element of ENV so we'll get the new value
      * in the future. */
@@ -4204,8 +4240,8 @@ PP(pp_system)
            if (did_pipes)
                PerlLIO_close(pp[1]);
 #ifndef PERL_MICRO
-           rsignal_save(SIGINT, SIG_IGN, &ihand);
-           rsignal_save(SIGQUIT, SIG_IGN, &qhand);
+           rsignal_save(SIGINT,  (Sighandler_t) SIG_IGN, &ihand);
+           rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
 #endif
            do {
                result = wait4pid(childpid, &status, 0);
@@ -4536,14 +4572,16 @@ static struct tm *S_my_localtime (pTHX_ Time_t *tp)
      * Given that legal timezones are typically between GMT-12 and GMT+12
      * we turn back the clock 23 hours before calling the localtime
      * function, and add those to the return value. This will never cause
-     * day wrapping problems, since the edge case is Jan *19*
+     * day wrapping problems, since the edge case is Tue Jan *19*
      */
     T = *tp - 82800; /* 23 hour. allows up to GMT-23 */
     P = localtime (&T);
     P->tm_hour += 23;
     if (P->tm_hour >= 24) {
        P->tm_hour -= 24;
-       P->tm_mday++;
+       P->tm_mday++;   /* 18  -> 19  */
+       P->tm_wday++;   /* Mon -> Tue */
+       P->tm_yday++;   /* 18  -> 19  */
     }
     return (P);
 } /* S_my_localtime */