projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
belatedly add a test for RT #51636:
[p5sagit/p5-mst-13.2.git] / pp_sys.c
diff --git a/pp_sys.c b/pp_sys.c
index d3430d1..59ec533 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -318,13 +318,13 @@ PP(pp_backtick)
                NOOP;
        }
        else if (gimme == G_SCALAR) {
-           ENTER;
+           ENTER_with_name("backtick");
            SAVESPTR(PL_rs);
            PL_rs = &PL_sv_undef;
            sv_setpvs(TARG, "");        /* note that this preserves previous buffer */
            while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
                NOOP;
-           LEAVE;
+           LEAVE_with_name("backtick");
            XPUSHs(TARG);
            SvTAINTED_on(TARG);
        }
@@ -364,7 +364,7 @@ PP(pp_glob)
      * without at the same time croaking, for some reason, or if
      * perl was built with PERL_EXTERNAL_GLOB */
 
-    ENTER;
+    ENTER_with_name("glob");
 
 #ifndef VMS
     if (PL_tainting) {
@@ -389,7 +389,7 @@ PP(pp_glob)
 #endif /* !DOSISH */
 
     result = do_readline();
-    LEAVE;
+    LEAVE_with_name("glob");
     return result;
 }
 
@@ -403,100 +403,92 @@ PP(pp_rcatline)
 PP(pp_warn)
 {
     dVAR; dSP; dMARK;
-    SV *tmpsv;
-    const char *tmps;
+    SV *exsv;
+    const char *pv;
     STRLEN len;
     if (SP - MARK > 1) {
        dTARGET;
        do_join(TARG, &PL_sv_no, MARK, SP);
-       tmpsv = TARG;
+       exsv = TARG;
        SP = MARK + 1;
     }
     else if (SP == MARK) {
-       tmpsv = &PL_sv_no;
+       exsv = &PL_sv_no;
        EXTEND(SP, 1);
        SP = MARK + 1;
     }
     else {
-       tmpsv = TOPs;
+       exsv = TOPs;
     }
-    tmps = SvPV_const(tmpsv, len);
-    if ((!tmps || !len) && PL_errgv) {
-       SV * const error = ERRSV;
-       SvUPGRADE(error, SVt_PV);
-       if (SvPOK(error) && SvCUR(error))
-           sv_catpvs(error, "\t...caught");
-       tmpsv = error;
-       tmps = SvPV_const(tmpsv, len);
-    }
-    if (!tmps || !len)
-       tmpsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
 
-    Perl_warn(aTHX_ "%"SVf, SVfARG(tmpsv));
+    if (SvROK(exsv) || (pv = SvPV_const(exsv, len), len)) {
+       /* well-formed exception supplied */
+    }
+    else if (SvROK(ERRSV)) {
+       exsv = ERRSV;
+    }
+    else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
+       exsv = sv_mortalcopy(ERRSV);
+       sv_catpvs(exsv, "\t...caught");
+    }
+    else {
+       exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
+    }
+    warn_sv(exsv);
     RETSETYES;
 }
 
 PP(pp_die)
 {
     dVAR; dSP; dMARK;
-    const char *tmps;
-    SV *tmpsv;
+    SV *exsv;
+    const char *pv;
     STRLEN len;
-    bool multiarg = 0;
 #ifdef VMS
     VMSISH_HUSHED  = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
 #endif
     if (SP - MARK != 1) {
        dTARGET;
        do_join(TARG, &PL_sv_no, MARK, SP);
-       tmpsv = TARG;
-       tmps = SvPV_const(tmpsv, len);
-       multiarg = 1;
+       exsv = TARG;
        SP = MARK + 1;
     }
     else {
-       tmpsv = TOPs;
-        tmps = SvROK(tmpsv) ? (const char *)NULL : SvPV_const(tmpsv, len);
-    }
-    if (!tmps || !len) {
-       SV * const error = ERRSV;
-       SvUPGRADE(error, SVt_PV);
-       if (multiarg ? SvROK(error) : SvROK(tmpsv)) {
-           if (!multiarg)
-               SvSetSV(error,tmpsv);
-           else if (sv_isobject(error)) {
-               HV * const stash = SvSTASH(SvRV(error));
-               GV * const gv = gv_fetchmethod(stash, "PROPAGATE");
-               if (gv) {
-                   SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
-                   SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
-                   EXTEND(SP, 3);
-                   PUSHMARK(SP);
-                   PUSHs(error);
-                   PUSHs(file);
-                   PUSHs(line);
-                   PUTBACK;
-                   call_sv(MUTABLE_SV(GvCV(gv)),
-                           G_SCALAR|G_EVAL|G_KEEPERR);
-                   sv_setsv(error,*PL_stack_sp--);
-               }
+       exsv = TOPs;
+    }
+
+    if (SvROK(exsv) || (pv = SvPV_const(exsv, len), len)) {
+       /* well-formed exception supplied */
+    }
+    else if (SvROK(ERRSV)) {
+       exsv = ERRSV;
+       if (sv_isobject(exsv)) {
+           HV * const stash = SvSTASH(SvRV(exsv));
+           GV * const gv = gv_fetchmethod(stash, "PROPAGATE");
+           if (gv) {
+               SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
+               SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
+               EXTEND(SP, 3);
+               PUSHMARK(SP);
+               PUSHs(exsv);
+               PUSHs(file);
+               PUSHs(line);
+               PUTBACK;
+               call_sv(MUTABLE_SV(GvCV(gv)),
+                       G_SCALAR|G_EVAL|G_KEEPERR);
+               exsv = sv_mortalcopy(*PL_stack_sp--);
            }
-           DIE(aTHX_ NULL);
-       }
-       else {
-           if (SvPOK(error) && SvCUR(error))
-               sv_catpvs(error, "\t...propagated");
-           tmpsv = error;
-           if (SvOK(tmpsv))
-               tmps = SvPV_const(tmpsv, len);
-           else
-               tmps = NULL;
        }
     }
-    if (!tmps || !len)
-       tmpsv = newSVpvs_flags("Died", SVs_TEMP);
-
-    DIE(aTHX_ "%"SVf, SVfARG(tmpsv));
+    else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
+       exsv = sv_mortalcopy(ERRSV);
+       sv_catpvs(exsv, "\t...propagated");
+    }
+    else {
+       exsv = newSVpvs_flags("Died", SVs_TEMP);
+    }
+    die_sv(exsv);
+    RETURN;
 }
 
 /* I/O. */
@@ -533,9 +525,9 @@ PP(pp_open)
            *MARK-- = SvTIED_obj(MUTABLE_SV(io), mg);
            PUSHMARK(MARK);
            PUTBACK;
-           ENTER;
+           ENTER_with_name("call_OPEN");
            call_method("OPEN", G_SCALAR);
-           LEAVE;
+           LEAVE_with_name("call_OPEN");
            SPAGAIN;
            RETURN;
        }
@@ -573,9 +565,9 @@ PP(pp_close)
                PUSHMARK(SP);
                XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
                PUTBACK;
-               ENTER;
+               ENTER_with_name("call_CLOSE");
                call_method("CLOSE", G_SCALAR);
-               LEAVE;
+               LEAVE_with_name("call_CLOSE");
                SPAGAIN;
                RETURN;
            }
@@ -642,6 +634,7 @@ badexit:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");
+    return NORMAL;
 #endif
 }
 
@@ -663,9 +656,9 @@ PP(pp_fileno)
        PUSHMARK(SP);
        XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
        PUTBACK;
-       ENTER;
+       ENTER_with_name("call_FILENO");
        call_method("FILENO", G_SCALAR);
-       LEAVE;
+       LEAVE_with_name("call_FILENO");
        SPAGAIN;
        RETURN;
     }
@@ -738,9 +731,9 @@ PP(pp_binmode)
            if (discp)
                XPUSHs(discp);
            PUTBACK;
-           ENTER;
+           ENTER_with_name("call_BINMODE");
            call_method("BINMODE", G_SCALAR);
-           LEAVE;
+           LEAVE_with_name("call_BINMODE");
            SPAGAIN;
            RETURN;
        }
@@ -783,7 +776,7 @@ PP(pp_tie)
 {
     dVAR; dSP; dMARK;
     HV* stash;
-    GV *gv;
+    GV *gv = NULL;
     SV *sv;
     const I32 markoff = MARK - PL_stack_base;
     const char *methname;
@@ -818,7 +811,7 @@ PP(pp_tie)
     }
     items = SP - MARK++;
     if (sv_isobject(*MARK)) { /* Calls GET magic. */
-       ENTER;
+       ENTER_with_name("call_TIE");
        PUSHSTACKi(PERLSI_MAGIC);
        PUSHMARK(SP);
        EXTEND(SP,(I32)items);
@@ -838,7 +831,7 @@ PP(pp_tie)
            DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
                 methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
        }
-       ENTER;
+       ENTER_with_name("call_TIE");
        PUSHSTACKi(PERLSI_MAGIC);
        PUSHMARK(SP);
        EXTEND(SP,(I32)items);
@@ -861,7 +854,7 @@ PP(pp_tie)
                       "Self-ties of arrays and hashes are not supported");
        sv_magic(varsv, (SvRV(sv) == varsv ? NULL : sv), how, NULL, 0);
     }
-    LEAVE;
+    LEAVE_with_name("call_TIE");
     SP = PL_stack_base + markoff;
     PUSHs(sv);
     RETURN;
@@ -888,9 +881,9 @@ PP(pp_untie)
               XPUSHs(SvTIED_obj(MUTABLE_SV(gv), mg));
               mXPUSHi(SvREFCNT(obj) - 1);
               PUTBACK;
-              ENTER;
+              ENTER_with_name("call_UNTIE");
               call_sv(MUTABLE_SV(cv), G_VOID);
-              LEAVE;
+              LEAVE_with_name("call_UNTIE");
               SPAGAIN;
             }
            else if (mg && SvREFCNT(obj) > 1) {
@@ -931,7 +924,7 @@ PP(pp_dbmopen)
     dVAR; dSP;
     dPOPPOPssrl;
     HV* stash;
-    GV *gv;
+    GV *gv = NULL;
 
     HV * const hv = MUTABLE_HV(POPs);
     SV * const sv = newSVpvs_flags("AnyDBM_File", SVs_TEMP);
@@ -1139,6 +1132,7 @@ PP(pp_sselect)
     RETURN;
 #else
     DIE(aTHX_ "select not implemented");
+    return NORMAL;
 #endif
 }
 
@@ -1158,8 +1152,7 @@ Perl_setdefout(pTHX_ GV *gv)
 {
     dVAR;
     SvREFCNT_inc_simple_void(gv);
-    if (PL_defoutgv)
-       SvREFCNT_dec(PL_defoutgv);
+    SvREFCNT_dec(PL_defoutgv);
     PL_defoutgv = gv;
 }
 
@@ -1168,11 +1161,11 @@ PP(pp_select)
     dVAR; dSP; dTARGET;
     HV *hv;
     GV * const newdefout = (PL_op->op_private > 0) ? (MUTABLE_GV(POPs)) : NULL;
-    GV * egv = GvEGV(PL_defoutgv);
+    GV * egv = GvEGVx(PL_defoutgv);
 
     if (!egv)
        egv = PL_defoutgv;
-    hv = GvSTASH(egv);
+    hv = isGV_with_GP(egv) ? GvSTASH(egv) : NULL;
     if (! hv)
        XPUSHs(&PL_sv_undef);
     else {
@@ -1269,8 +1262,8 @@ PP(pp_enterwrite)
     register GV *gv;
     register IO *io;
     GV *fgv;
-    CV *cv;
-    SV * tmpsv = NULL;
+    CV *cv = NULL;
+    SV *tmpsv = NULL;
 
     if (MAXARG == 0)
        gv = PL_defoutgv;
@@ -1918,7 +1911,7 @@ PP(pp_send)
                    DIE(aTHX_ "Offset outside string");
                }
                offset += blen_chars;
-           } else if (offset >= (IV)blen_chars) {
+           } else if (offset > (IV)blen_chars) {
                Safefree(tmpbuf);
                DIE(aTHX_ "Offset outside string");
            }
@@ -2015,7 +2008,7 @@ PP(pp_eof)
     if (MAXARG)
        gv = PL_last_in_gv = MUTABLE_GV(POPs);  /* eof(FH) */
     else if (PL_op->op_flags & OPf_SPECIAL)
-       gv = PL_last_in_gv = GvEGV(PL_argvgv);  /* eof() - ARGV magic */
+       gv = PL_last_in_gv = GvEGVx(PL_argvgv); /* eof() - ARGV magic */
     else
        gv = PL_last_in_gv;                     /* eof */
 
@@ -2358,6 +2351,7 @@ PP(pp_flock)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "flock()");
+    return NORMAL;
 #endif
 }
 
@@ -2410,6 +2404,7 @@ PP(pp_socket)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "socket");
+    return NORMAL;
 #endif
 }
 
@@ -2471,6 +2466,7 @@ PP(pp_sockpair)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "socketpair");
+    return NORMAL;
 #endif
 }
 
@@ -2502,6 +2498,7 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "bind");
+    return NORMAL;
 #endif
 }
 
@@ -2532,6 +2529,7 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "connect");
+    return NORMAL;
 #endif
 }
 
@@ -2558,6 +2556,7 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "listen");
+    return NORMAL;
 #endif
 }
 
@@ -2637,6 +2636,7 @@ badexit:
 
 #else
     DIE(aTHX_ PL_no_sock_func, "accept");
+    return NORMAL;
 #endif
 }
 
@@ -2661,6 +2661,7 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "shutdown");
+    return NORMAL;
 #endif
 }
 
@@ -2738,6 +2739,7 @@ nuts2:
 
 #else
     DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
+    return NORMAL;
 #endif
 }
 
@@ -2802,6 +2804,7 @@ nuts2:
 
 #else
     DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
+    return NORMAL;
 #endif
 }
 
@@ -2947,6 +2950,53 @@ PP(pp_stat)
     RETURN;
 }
 
+#define tryAMAGICftest_MG(chr) STMT_START { \
+       if ( (SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG)) \
+               && S_try_amagic_ftest(aTHX_ chr)) \
+           return NORMAL; \
+    } STMT_END
+
+STATIC bool
+S_try_amagic_ftest(pTHX_ char chr) {
+    dVAR;
+    dSP;
+    SV* const arg = TOPs;
+
+    assert(chr != '?');
+    SvGETMAGIC(arg);
+
+    if ((PL_op->op_flags & OPf_KIDS)
+           && SvAMAGIC(TOPs))
+    {
+       const char tmpchr = chr;
+       const OP *next;
+       SV * const tmpsv = amagic_call(arg,
+                               newSVpvn_flags(&tmpchr, 1, SVs_TEMP),
+                               ftest_amg, AMGf_unary);
+
+       if (!tmpsv)
+           return FALSE;
+
+       SPAGAIN;
+
+       next = PL_op->op_next;
+       if (next->op_type >= OP_FTRREAD &&
+           next->op_type <= OP_FTBINARY &&
+           next->op_private & OPpFT_STACKED
+       ) {
+           if (SvTRUE(tmpsv))
+               /* leave the object alone */
+               return TRUE;
+       }
+
+       SETs(tmpsv);
+       PUTBACK;
+       return TRUE;
+    }
+    return FALSE;
+}
+
+
 /* This macro is used by the stacked filetest operators :
  * if the previous filetest failed, short-circuit and pass its value.
  * Else, discard it from the stack and continue. --rgs
@@ -2989,7 +3039,7 @@ PP(pp_ftrread)
     case OP_FTEWRITE:  opchar = 'w'; break;
     case OP_FTEEXEC:   opchar = 'x'; break;
     }
-    tryAMAGICftest(opchar);
+    tryAMAGICftest_MG(opchar);
 
     STACKED_FTEST_CHECK;
 
@@ -3093,7 +3143,7 @@ PP(pp_ftis)
     case OP_FTCTIME:   opchar = 'C'; break;
     case OP_FTATIME:   opchar = 'A'; break;
     }
-    tryAMAGICftest(opchar);
+    tryAMAGICftest_MG(opchar);
 
     STACKED_FTEST_CHECK;
 
@@ -3150,7 +3200,7 @@ PP(pp_ftrowned)
     case OP_FTSGID:    opchar = 'g'; break;
     case OP_FTSVTX:    opchar = 'k'; break;
     }
-    tryAMAGICftest(opchar);
+    tryAMAGICftest_MG(opchar);
 
     /* I believe that all these three are likely to be defined on most every
        system these days.  */
@@ -3238,7 +3288,7 @@ PP(pp_ftlink)
     dSP;
     I32 result;
 
-    tryAMAGICftest('l');
+    tryAMAGICftest_MG('l');
     result = my_lstat();
     SPAGAIN;
 
@@ -3257,7 +3307,7 @@ PP(pp_fttty)
     GV *gv;
     SV *tmpsv = NULL;
 
-    tryAMAGICftest('t');
+    tryAMAGICftest_MG('t');
 
     STACKED_FTEST_CHECK;
 
@@ -3308,7 +3358,7 @@ PP(pp_fttext)
     GV *gv;
     PerlIO *fp;
 
-    tryAMAGICftest(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
+    tryAMAGICftest_MG(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
 
     STACKED_FTEST_CHECK;
 
@@ -3556,6 +3606,7 @@ PP(pp_chroot)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "chroot");
+    return NORMAL;
 #endif
 }
 
@@ -3630,6 +3681,7 @@ PP(pp_link)
 {
     /* Have neither.  */
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+    return NORMAL;
 }
 #endif
 
@@ -3845,6 +3897,7 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "opendir");
+    return NORMAL;
 #endif
 }
 
@@ -3852,6 +3905,7 @@ PP(pp_readdir)
 {
 #if !defined(Direntry_t) || !defined(HAS_READDIR)
     DIE(aTHX_ PL_no_dir_func, "readdir");
+    return NORMAL;
 #else
 #if !defined(I_DIRENT) && !defined(VMS)
     Direntry_t *readdir (DIR *);
@@ -3930,6 +3984,7 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "telldir");
+    return NORMAL;
 #endif
 }
 
@@ -3955,6 +4010,7 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "seekdir");
+    return NORMAL;
 #endif
 }
 
@@ -3978,6 +4034,7 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "rewinddir");
+    return NORMAL;
 #endif
 }
 
@@ -4010,6 +4067,7 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "closedir");
+    return NORMAL;
 #endif
 }
 
@@ -4056,6 +4114,7 @@ PP(pp_fork)
     RETURN;
 #  else
     DIE(aTHX_ PL_no_func, "fork");
+    return NORMAL;
 #  endif
 #endif
 }
@@ -4085,6 +4144,7 @@ PP(pp_wait)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "wait");
+    return NORMAL;
 #endif
 }
 
@@ -4115,6 +4175,7 @@ PP(pp_waitpid)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "waitpid");
+    return NORMAL;
 #endif
 }
 
@@ -4320,6 +4381,7 @@ PP(pp_getppid)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getppid");
+    return NORMAL;
 #endif
 }
 
@@ -4341,6 +4403,7 @@ PP(pp_getpgrp)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getpgrp()");
+    return NORMAL;
 #endif
 }
 
@@ -4374,6 +4437,7 @@ PP(pp_setpgrp)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "setpgrp()");
+    return NORMAL;
 #endif
 }
 
@@ -4387,6 +4451,7 @@ PP(pp_getpriority)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getpriority()");
+    return NORMAL;
 #endif
 }
 
@@ -4402,6 +4467,7 @@ PP(pp_setpriority)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "setpriority()");
+    return NORMAL;
 #endif
 }
 
@@ -4452,10 +4518,20 @@ PP(pp_tms)
     RETURN;
 #   else
     DIE(aTHX_ "times not implemented");
+    return NORMAL;
 #   endif
 #endif /* HAS_TIMES */
 }
 
+/* The 32 bit int year limits the times we can represent to these
+   boundaries with a few days wiggle room to account for time zone
+   offsets
+*/
+/* Sat Jan  3 00:00:00 -2147481748 */
+#define TIME_LOWER_BOUND -67768100567755200.0
+/* Sun Dec 29 12:00:00  2147483647 */
+#define TIME_UPPER_BOUND  67767976233316800.0
+
 PP(pp_gmtime)
 {
     dVAR;
@@ -4476,23 +4552,35 @@ PP(pp_gmtime)
        when = (Time64_T)now;
     }
     else {
-       double input = Perl_floor(POPn);
+       NV input = Perl_floor(POPn);
        when = (Time64_T)input;
        if (when != input) {
            Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
-                          "%s(%.0f) too large", opname, input);
+                          "%s(%.0" NVff ") too large", opname, input);
        }
     }
 
-    if (PL_op->op_type == OP_LOCALTIME)
-        err = S_localtime64_r(&when, &tmbuf);
-    else
-       err = S_gmtime64_r(&when, &tmbuf);
+    if ( TIME_LOWER_BOUND > when ) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                      "%s(%.0" NVff ") too small", opname, when);
+       err = NULL;
+    }
+    else if( when > TIME_UPPER_BOUND ) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                      "%s(%.0" NVff ") too large", opname, when);
+       err = NULL;
+    }
+    else {
+       if (PL_op->op_type == OP_LOCALTIME)
+           err = S_localtime64_r(&when, &tmbuf);
+       else
+           err = S_gmtime64_r(&when, &tmbuf);
+    }
 
     if (err == NULL) {
        /* XXX %lld broken for quads */
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
-                      "%s(%.0f) failed", opname, (double)when);
+                      "%s(%.0" NVff ") failed", opname, when);
     }
 
     if (GIMME != G_ARRAY) {    /* scalar context */
@@ -4548,6 +4636,7 @@ PP(pp_alarm)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "alarm");
+    return NORMAL;
 #endif
 }
 
@@ -4617,6 +4706,7 @@ PP(pp_semget)
     RETURN;
 #else
     DIE(aTHX_ "System V IPC is not implemented on this machine");
+    return NORMAL;
 #endif
 }
 
@@ -4677,7 +4767,7 @@ PP(pp_ghostent)
     struct hostent *gethostbyname(Netdb_name_t);
     struct hostent *gethostent(void);
 #endif
-    struct hostent *hent;
+    struct hostent *hent = NULL;
     unsigned long len;
 
     EXTEND(SP, 10);
@@ -4752,6 +4842,7 @@ PP(pp_ghostent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "gethostent");
+    return NORMAL;
 #endif
 }
 
@@ -4825,6 +4916,7 @@ PP(pp_gnetent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getnetent");
+    return NORMAL;
 #endif
 }
 
@@ -4885,6 +4977,7 @@ PP(pp_gprotoent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getprotoent");
+    return NORMAL;
 #endif
 }
 
@@ -4960,6 +5053,7 @@ PP(pp_gservent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getservent");
+    return NORMAL;
 #endif
 }
 
@@ -4971,6 +5065,7 @@ PP(pp_shostent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "sethostent");
+    return NORMAL;
 #endif
 }
 
@@ -4982,6 +5077,7 @@ PP(pp_snetent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setnetent");
+    return NORMAL;
 #endif
 }
 
@@ -4993,6 +5089,7 @@ PP(pp_sprotoent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setprotoent");
+    return NORMAL;
 #endif
 }
 
@@ -5004,6 +5101,7 @@ PP(pp_sservent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setservent");
+    return NORMAL;
 #endif
 }
 
@@ -5016,6 +5114,7 @@ PP(pp_ehostent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endhostent");
+    return NORMAL;
 #endif
 }
 
@@ -5028,6 +5127,7 @@ PP(pp_enetent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endnetent");
+    return NORMAL;
 #endif
 }
 
@@ -5040,6 +5140,7 @@ PP(pp_eprotoent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endprotoent");
+    return NORMAL;
 #endif
 }
 
@@ -5052,6 +5153,7 @@ PP(pp_eservent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endservent");
+    return NORMAL;
 #endif
 }
 
@@ -5285,6 +5387,7 @@ PP(pp_gpwent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+    return NORMAL;
 #endif
 }
 
@@ -5296,6 +5399,7 @@ PP(pp_spwent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "setpwent");
+    return NORMAL;
 #endif
 }
 
@@ -5307,6 +5411,7 @@ PP(pp_epwent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "endpwent");
+    return NORMAL;
 #endif
 }
 
@@ -5381,6 +5486,7 @@ PP(pp_ggrent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+    return NORMAL;
 #endif
 }
 
@@ -5392,6 +5498,7 @@ PP(pp_sgrent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "setgrent");
+    return NORMAL;
 #endif
 }
 
@@ -5403,6 +5510,7 @@ PP(pp_egrent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "endgrent");
+    return NORMAL;
 #endif
 }
 
@@ -5418,6 +5526,7 @@ PP(pp_getlogin)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getlogin");
+    return NORMAL;
 #endif
 }
 
@@ -5516,6 +5625,7 @@ PP(pp_syscall)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "syscall");
+    return NORMAL;
 #endif
 }
 
@@ -5528,6 +5638,7 @@ PP(pp_syscall)
 static int
 fcntl_emulate_flock(int fd, int operation)
 {
+    int res;
     struct flock flock;
 
     switch (operation & ~LOCK_NB) {
@@ -5547,7 +5658,10 @@ fcntl_emulate_flock(int fd, int operation)
     flock.l_whence = SEEK_SET;
     flock.l_start = flock.l_len = (Off_t)0;
 
-    return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
+    res = fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
+    if (res == -1 && ((errno == EAGAIN) || (errno == EACCES)))
+       errno = EWOULDBLOCK;
+    return res;
 }
 
 #endif /* FCNTL_EMULATE_FLOCK */
Unnamed repository; edit this file to name it for gitweb.