This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Add the new maint policy to perlpolicy.pod
[perl5.git] / pp_sys.c
diff --git a/pp_sys.c b/pp_sys.c
index 225b55e..8dd8bc0 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -242,7 +242,6 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     const Gid_t egid = getegid();
     int res;
 
-    LOCK_CRED_MUTEX;
 #if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID)
     Perl_croak(aTHX_ "switching effective uid is not implemented");
 #else
@@ -288,7 +287,6 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 #endif
 #endif
        Perl_croak(aTHX_ "leaving effective gid failed");
-    UNLOCK_CRED_MUTEX;
 
     return res;
 }
@@ -320,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);
        }
@@ -366,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) {
@@ -391,7 +389,7 @@ PP(pp_glob)
 #endif /* !DOSISH */
 
     result = do_readline();
-    LEAVE;
+    LEAVE_with_name("glob");
     return result;
 }
 
@@ -499,6 +497,7 @@ PP(pp_die)
        tmpsv = newSVpvs_flags("Died", SVs_TEMP);
 
     DIE(aTHX_ "%"SVf, SVfARG(tmpsv));
+    RETURN;
 }
 
 /* I/O. */
@@ -523,9 +522,10 @@ PP(pp_open)
        MAGIC *mg;
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
-       if (IoDIRP(io) && ckWARN2(WARN_IO, WARN_DEPRECATED))
-           Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                   "Opening dirhandle %s also as a file", GvENAME(gv));
+       if (IoDIRP(io))
+           Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+                            "Opening dirhandle %s also as a file",
+                            GvENAME(gv));
 
        mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
@@ -534,9 +534,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;
        }
@@ -574,9 +574,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;
            }
@@ -643,6 +643,7 @@ badexit:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");
+    return NORMAL;
 #endif
 }
 
@@ -664,9 +665,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;
     }
@@ -739,9 +740,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;
        }
@@ -784,7 +785,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;
@@ -802,11 +803,6 @@ PP(pp_tie)
            break;
        case SVt_PVGV:
            if (isGV_with_GP(varsv)) {
-#ifdef GV_UNIQUE_CHECK
-               if (GvUNIQUE((const GV *)varsv)) {
-                   Perl_croak(aTHX_ "Attempt to tie unique GV");
-               }
-#endif
                methname = "TIEHANDLE";
                how = PERL_MAGIC_tiedscalar;
                /* For tied filehandles, we apply tiedscalar magic to the IO
@@ -824,7 +820,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);
@@ -844,7 +840,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);
@@ -867,7 +863,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;
@@ -894,15 +890,15 @@ 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 && ckWARN(WARN_UNTIE)) {
-                 Perl_warner(aTHX_ packWARN(WARN_UNTIE),
-                     "untie attempted while %"UVuf" inner references still exist",
-                      (UV)SvREFCNT(obj) - 1 ) ;
+           else if (mg && SvREFCNT(obj) > 1) {
+               Perl_ck_warner(aTHX_ packWARN(WARN_UNTIE),
+                              "untie attempted while %"UVuf" inner references still exist",
+                              (UV)SvREFCNT(obj) - 1 ) ;
            }
         }
     }
@@ -937,7 +933,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);
@@ -1025,8 +1021,7 @@ PP(pp_sselect)
                DIE(aTHX_ "%s", PL_no_modify);
        }
        if (!SvPOK(sv)) {
-           if (ckWARN(WARN_MISC))
-                Perl_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask");
+           Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask");
            SvPV_force_nolen(sv);       /* force string conversion */
        }
        j = SvCUR(sv);
@@ -1146,6 +1141,7 @@ PP(pp_sselect)
     RETURN;
 #else
     DIE(aTHX_ "select not implemented");
+    return NORMAL;
 #endif
 }
 
@@ -1165,8 +1161,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;
 }
 
@@ -1175,11 +1170,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 {
@@ -1276,8 +1271,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;
@@ -1424,8 +1419,7 @@ PP(pp_leavewrite)
     }
     else {
        if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
-           if (ckWARN(WARN_IO))
-               Perl_warner(aTHX_ packWARN(WARN_IO), "page overflow");
+           Perl_ck_warner(aTHX_ packWARN(WARN_IO), "page overflow");
        }
        if (!do_print(PL_formtarget, fp))
            PUSHs(&PL_sv_no);
@@ -1816,9 +1810,8 @@ PP(pp_send)
            SV *sv;
 
            if (MARK == SP - 1) {
-               EXTEND(SP, 1000);
-               sv = sv_2mortal(newSViv(sv_len(*SP)));
-               PUSHs(sv);
+               sv = *SP;
+               mXPUSHi(sv_len(sv));
                PUTBACK;
            }
 
@@ -1927,7 +1920,7 @@ PP(pp_send)
                    DIE(aTHX_ "Offset outside string");
                }
                offset += blen_chars;
-           } else if (offset >= (IV)blen_chars && blen_chars > 0) {
+           } else if (offset > (IV)blen_chars) {
                Safefree(tmpbuf);
                DIE(aTHX_ "Offset outside string");
            }
@@ -2024,7 +2017,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 */
 
@@ -2098,6 +2091,12 @@ PP(pp_tell)
            RETURN;
        }
     }
+    else if (!gv) {
+       if (!errno)
+           SETERRNO(EBADF,RMS_IFI);
+       PUSHi(-1);
+       RETURN;
+    }
 
 #if LSEEKSIZE > IVSIZE
     PUSHn( do_tell(gv) );
@@ -2361,6 +2360,7 @@ PP(pp_flock)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "flock()");
+    return NORMAL;
 #endif
 }
 
@@ -2413,6 +2413,7 @@ PP(pp_socket)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "socket");
+    return NORMAL;
 #endif
 }
 
@@ -2474,6 +2475,7 @@ PP(pp_sockpair)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "socketpair");
+    return NORMAL;
 #endif
 }
 
@@ -2505,6 +2507,7 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "bind");
+    return NORMAL;
 #endif
 }
 
@@ -2535,6 +2538,7 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "connect");
+    return NORMAL;
 #endif
 }
 
@@ -2561,6 +2565,7 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "listen");
+    return NORMAL;
 #endif
 }
 
@@ -2640,6 +2645,7 @@ badexit:
 
 #else
     DIE(aTHX_ PL_no_sock_func, "accept");
+    return NORMAL;
 #endif
 }
 
@@ -2664,6 +2670,7 @@ nuts:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "shutdown");
+    return NORMAL;
 #endif
 }
 
@@ -2741,6 +2748,7 @@ nuts2:
 
 #else
     DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
+    return NORMAL;
 #endif
 }
 
@@ -2805,6 +2813,7 @@ nuts2:
 
 #else
     DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
+    return NORMAL;
 #endif
 }
 
@@ -2824,9 +2833,8 @@ PP(pp_stat)
        if (PL_op->op_type == OP_LSTAT) {
            if (gv != PL_defgv) {
            do_fstat_warning_check:
-               if (ckWARN(WARN_IO))
-                   Perl_warner(aTHX_ packWARN(WARN_IO),
-                       "lstat() on filehandle %s", gv ? GvENAME(gv) : "");
+               Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                              "lstat() on filehandle %s", gv ? GvENAME(gv) : "");
            } else if (PL_laststype != OP_LSTAT)
                Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
        }
@@ -2982,8 +2990,19 @@ PP(pp_ftrread)
     int stat_mode = S_IRUSR;
 
     bool effective = FALSE;
+    char opchar = '?';
     dSP;
 
+    switch (PL_op->op_type) {
+    case OP_FTRREAD:   opchar = 'R'; break;
+    case OP_FTRWRITE:  opchar = 'W'; break;
+    case OP_FTREXEC:   opchar = 'X'; break;
+    case OP_FTEREAD:   opchar = 'r'; break;
+    case OP_FTEWRITE:  opchar = 'w'; break;
+    case OP_FTEEXEC:   opchar = 'x'; break;
+    }
+    tryAMAGICftest(opchar);
+
     STACKED_FTEST_CHECK;
 
     switch (PL_op->op_type) {
@@ -3016,7 +3035,7 @@ PP(pp_ftrread)
        access_mode = W_OK;
 #endif
        stat_mode = S_IWUSR;
-       /* Fall through  */
+       /* fall through */
 
     case OP_FTEREAD:
 #ifndef PERL_EFF_ACCESS
@@ -3076,8 +3095,20 @@ PP(pp_ftis)
     dVAR;
     I32 result;
     const int op_type = PL_op->op_type;
+    char opchar = '?';
     dSP;
+
+    switch (op_type) {
+    case OP_FTIS:      opchar = 'e'; break;
+    case OP_FTSIZE:    opchar = 's'; break;
+    case OP_FTMTIME:   opchar = 'M'; break;
+    case OP_FTCTIME:   opchar = 'C'; break;
+    case OP_FTATIME:   opchar = 'A'; break;
+    }
+    tryAMAGICftest(opchar);
+
     STACKED_FTEST_CHECK;
+
     result = my_stat();
     SPAGAIN;
     if (result < 0)
@@ -3114,8 +3145,25 @@ PP(pp_ftrowned)
 {
     dVAR;
     I32 result;
+    char opchar = '?';
     dSP;
 
+    switch (PL_op->op_type) {
+    case OP_FTROWNED:  opchar = 'O'; break;
+    case OP_FTEOWNED:  opchar = 'o'; break;
+    case OP_FTZERO:    opchar = 'z'; break;
+    case OP_FTSOCK:    opchar = 'S'; break;
+    case OP_FTCHR:     opchar = 'c'; break;
+    case OP_FTBLK:     opchar = 'b'; break;
+    case OP_FTFILE:    opchar = 'f'; break;
+    case OP_FTDIR:     opchar = 'd'; break;
+    case OP_FTPIPE:    opchar = 'p'; break;
+    case OP_FTSUID:    opchar = 'u'; break;
+    case OP_FTSGID:    opchar = 'g'; break;
+    case OP_FTSVTX:    opchar = 'k'; break;
+    }
+    tryAMAGICftest(opchar);
+
     /* I believe that all these three are likely to be defined on most every
        system these days.  */
 #ifndef S_ISUID
@@ -3132,6 +3180,7 @@ PP(pp_ftrowned)
 #endif
 
     STACKED_FTEST_CHECK;
+
     result = my_stat();
     SPAGAIN;
     if (result < 0)
@@ -3198,8 +3247,13 @@ PP(pp_ftrowned)
 PP(pp_ftlink)
 {
     dVAR;
-    I32 result = my_lstat();
     dSP;
+    I32 result;
+
+    tryAMAGICftest('l');
+    result = my_lstat();
+    SPAGAIN;
+
     if (result < 0)
        RETPUSHUNDEF;
     if (S_ISLNK(PL_statcache.st_mode))
@@ -3215,6 +3269,8 @@ PP(pp_fttty)
     GV *gv;
     SV *tmpsv = NULL;
 
+    tryAMAGICftest('t');
+
     STACKED_FTEST_CHECK;
 
     if (PL_op->op_flags & OPf_REF)
@@ -3264,6 +3320,8 @@ PP(pp_fttext)
     GV *gv;
     PerlIO *fp;
 
+    tryAMAGICftest(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
+
     STACKED_FTEST_CHECK;
 
     if (PL_op->op_flags & OPf_REF)
@@ -3510,6 +3568,7 @@ PP(pp_chroot)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "chroot");
+    return NORMAL;
 #endif
 }
 
@@ -3584,6 +3643,7 @@ PP(pp_link)
 {
     /* Have neither.  */
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+    return NORMAL;
 }
 #endif
 
@@ -3783,9 +3843,10 @@ PP(pp_open_dir)
     if (!io)
        goto nope;
 
-    if ((IoIFP(io) || IoOFP(io)) && ckWARN2(WARN_IO, WARN_DEPRECATED))
-       Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-               "Opening filehandle %s also as a directory", GvENAME(gv));
+    if ((IoIFP(io) || IoOFP(io)))
+       Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+                        "Opening filehandle %s also as a directory",
+                        GvENAME(gv));
     if (IoDIRP(io))
        PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
@@ -3798,6 +3859,7 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "opendir");
+    return NORMAL;
 #endif
 }
 
@@ -3805,6 +3867,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 *);
@@ -3819,10 +3882,8 @@ PP(pp_readdir)
     register IO * const io = GvIOn(gv);
 
     if (!io || !IoDIRP(io)) {
-        if(ckWARN(WARN_IO)) {
-            Perl_warner(aTHX_ packWARN(WARN_IO),
-                "readdir() attempted on invalid dirhandle %s", GvENAME(gv));
-        }
+       Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                      "readdir() attempted on invalid dirhandle %s", GvENAME(gv));
         goto nope;
     }
 
@@ -3872,10 +3933,8 @@ PP(pp_telldir)
     register IO * const io = GvIOn(gv);
 
     if (!io || !IoDIRP(io)) {
-        if(ckWARN(WARN_IO)) {
-            Perl_warner(aTHX_ packWARN(WARN_IO),
-               "telldir() attempted on invalid dirhandle %s", GvENAME(gv));
-        }
+       Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                      "telldir() attempted on invalid dirhandle %s", GvENAME(gv));
         goto nope;
     }
 
@@ -3887,6 +3946,7 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "telldir");
+    return NORMAL;
 #endif
 }
 
@@ -3899,10 +3959,8 @@ PP(pp_seekdir)
     register IO * const io = GvIOn(gv);
 
     if (!io || !IoDIRP(io)) {
-       if(ckWARN(WARN_IO)) {
-           Perl_warner(aTHX_ packWARN(WARN_IO),
-                "seekdir() attempted on invalid dirhandle %s", GvENAME(gv));
-        }
+       Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                      "seekdir() attempted on invalid dirhandle %s", GvENAME(gv));
         goto nope;
     }
     (void)PerlDir_seek(IoDIRP(io), along);
@@ -3914,6 +3972,7 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "seekdir");
+    return NORMAL;
 #endif
 }
 
@@ -3925,10 +3984,8 @@ PP(pp_rewinddir)
     register IO * const io = GvIOn(gv);
 
     if (!io || !IoDIRP(io)) {
-       if(ckWARN(WARN_IO)) {
-           Perl_warner(aTHX_ packWARN(WARN_IO),
-               "rewinddir() attempted on invalid dirhandle %s", GvENAME(gv));
-       }
+       Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                      "rewinddir() attempted on invalid dirhandle %s", GvENAME(gv));
        goto nope;
     }
     (void)PerlDir_rewind(IoDIRP(io));
@@ -3939,6 +3996,7 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "rewinddir");
+    return NORMAL;
 #endif
 }
 
@@ -3950,10 +4008,8 @@ PP(pp_closedir)
     register IO * const io = GvIOn(gv);
 
     if (!io || !IoDIRP(io)) {
-       if(ckWARN(WARN_IO)) {
-           Perl_warner(aTHX_ packWARN(WARN_IO),
-                "closedir() attempted on invalid dirhandle %s", GvENAME(gv));
-        }
+       Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+                      "closedir() attempted on invalid dirhandle %s", GvENAME(gv));
         goto nope;
     }
 #ifdef VOID_CLOSEDIR
@@ -3973,6 +4029,7 @@ nope:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "closedir");
+    return NORMAL;
 #endif
 }
 
@@ -4019,13 +4076,14 @@ PP(pp_fork)
     RETURN;
 #  else
     DIE(aTHX_ PL_no_func, "fork");
+    return NORMAL;
 #  endif
 #endif
 }
 
 PP(pp_wait)
 {
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
     dVAR; dSP; dTARGET;
     Pid_t childpid;
     int argflags;
@@ -4048,12 +4106,13 @@ PP(pp_wait)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "wait");
+    return NORMAL;
 #endif
 }
 
 PP(pp_waitpid)
 {
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
     dVAR; dSP; dTARGET;
     const int optype = POPi;
     const Pid_t pid = TOPi;
@@ -4078,6 +4137,7 @@ PP(pp_waitpid)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "waitpid");
+    return NORMAL;
 #endif
 }
 
@@ -4283,6 +4343,7 @@ PP(pp_getppid)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getppid");
+    return NORMAL;
 #endif
 }
 
@@ -4304,6 +4365,7 @@ PP(pp_getpgrp)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getpgrp()");
+    return NORMAL;
 #endif
 }
 
@@ -4316,6 +4378,7 @@ PP(pp_setpgrp)
     if (MAXARG < 2) {
        pgrp = 0;
        pid = 0;
+       XPUSHi(-1);
     }
     else {
        pgrp = POPi;
@@ -4336,6 +4399,7 @@ PP(pp_setpgrp)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "setpgrp()");
+    return NORMAL;
 #endif
 }
 
@@ -4349,6 +4413,7 @@ PP(pp_getpriority)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getpriority()");
+    return NORMAL;
 #endif
 }
 
@@ -4364,6 +4429,7 @@ PP(pp_setpriority)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "setpriority()");
+    return NORMAL;
 #endif
 }
 
@@ -4414,10 +4480,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;
@@ -4438,27 +4514,35 @@ PP(pp_gmtime)
        when = (Time64_T)now;
     }
     else {
-       /* XXX POPq uses an SvIV so it won't work with 32 bit integer scalars
-          using a double causes an unfortunate loss of accuracy on high numbers.
-          What we really need is an SvQV.
-       */
-       double input = POPn;
+       double input = Perl_floor(POPn);
        when = (Time64_T)input;
-       if( when != input ) {
-           Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
-                       "%s(%.0f) too large", opname, input);
+       if (when != input) {
+           Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                          "%s(%.0f) too large", opname, input);
        }
     }
 
-    if (PL_op->op_type == OP_LOCALTIME)
-        err = localtime64_r(&when, &tmbuf);
-    else
-       err = gmtime64_r(&when, &tmbuf);
+    if ( TIME_LOWER_BOUND > when ) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                      "%s(%.0f) too small", opname, when);
+       err = NULL;
+    }
+    else if( when > TIME_UPPER_BOUND ) {
+       Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                      "%s(%.0f) 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 ) {
+    if (err == NULL) {
        /* XXX %lld broken for quads */
-       Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
-                   "%s(%.0f) failed", opname, (double)when);
+       Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+                      "%s(%.0f) failed", opname, (double)when);
     }
 
     if (GIMME != G_ARRAY) {    /* scalar context */
@@ -4514,6 +4598,7 @@ PP(pp_alarm)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "alarm");
+    return NORMAL;
 #endif
 }
 
@@ -4583,6 +4668,7 @@ PP(pp_semget)
     RETURN;
 #else
     DIE(aTHX_ "System V IPC is not implemented on this machine");
+    return NORMAL;
 #endif
 }
 
@@ -4643,7 +4729,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);
@@ -4718,6 +4804,7 @@ PP(pp_ghostent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "gethostent");
+    return NORMAL;
 #endif
 }
 
@@ -4791,6 +4878,7 @@ PP(pp_gnetent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getnetent");
+    return NORMAL;
 #endif
 }
 
@@ -4851,6 +4939,7 @@ PP(pp_gprotoent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getprotoent");
+    return NORMAL;
 #endif
 }
 
@@ -4926,6 +5015,7 @@ PP(pp_gservent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_sock_func, "getservent");
+    return NORMAL;
 #endif
 }
 
@@ -4937,6 +5027,7 @@ PP(pp_shostent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "sethostent");
+    return NORMAL;
 #endif
 }
 
@@ -4948,6 +5039,7 @@ PP(pp_snetent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setnetent");
+    return NORMAL;
 #endif
 }
 
@@ -4959,6 +5051,7 @@ PP(pp_sprotoent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setprotoent");
+    return NORMAL;
 #endif
 }
 
@@ -4970,6 +5063,7 @@ PP(pp_sservent)
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setservent");
+    return NORMAL;
 #endif
 }
 
@@ -4982,6 +5076,7 @@ PP(pp_ehostent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endhostent");
+    return NORMAL;
 #endif
 }
 
@@ -4994,6 +5089,7 @@ PP(pp_enetent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endnetent");
+    return NORMAL;
 #endif
 }
 
@@ -5006,6 +5102,7 @@ PP(pp_eprotoent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endprotoent");
+    return NORMAL;
 #endif
 }
 
@@ -5018,6 +5115,7 @@ PP(pp_eservent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "endservent");
+    return NORMAL;
 #endif
 }
 
@@ -5251,6 +5349,7 @@ PP(pp_gpwent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+    return NORMAL;
 #endif
 }
 
@@ -5262,6 +5361,7 @@ PP(pp_spwent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "setpwent");
+    return NORMAL;
 #endif
 }
 
@@ -5273,6 +5373,7 @@ PP(pp_epwent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "endpwent");
+    return NORMAL;
 #endif
 }
 
@@ -5305,7 +5406,11 @@ PP(pp_ggrent)
        PUSHs(sv);
        if (grent) {
            if (which == OP_GGRNAM)
+#if Gid_t_sign <= 0
                sv_setiv(sv, (IV)grent->gr_gid);
+#else
+               sv_setuv(sv, (UV)grent->gr_gid);
+#endif
            else
                sv_setpv(sv, grent->gr_name);
        }
@@ -5321,7 +5426,11 @@ PP(pp_ggrent)
        PUSHs(sv_mortalcopy(&PL_sv_no));
 #endif
 
+#if Gid_t_sign <= 0
        mPUSHi(grent->gr_gid);
+#else
+       mPUSHu(grent->gr_gid);
+#endif
 
 #if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API))
        /* In UNICOS/mk (_CRAYMPP) the multithreading
@@ -5339,6 +5448,7 @@ PP(pp_ggrent)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+    return NORMAL;
 #endif
 }
 
@@ -5350,6 +5460,7 @@ PP(pp_sgrent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "setgrent");
+    return NORMAL;
 #endif
 }
 
@@ -5361,6 +5472,7 @@ PP(pp_egrent)
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "endgrent");
+    return NORMAL;
 #endif
 }
 
@@ -5376,6 +5488,7 @@ PP(pp_getlogin)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getlogin");
+    return NORMAL;
 #endif
 }
 
@@ -5474,6 +5587,7 @@ PP(pp_syscall)
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "syscall");
+    return NORMAL;
 #endif
 }
 
@@ -5486,6 +5600,7 @@ PP(pp_syscall)
 static int
 fcntl_emulate_flock(int fd, int operation)
 {
+    int res;
     struct flock flock;
 
     switch (operation & ~LOCK_NB) {
@@ -5505,7 +5620,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 'description' to name the repository.