X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=8b5fccbd979818ae858223a4d655ab9240c9d3ad;hb=6821e3836b3437b3deb760f4225a6b3dbe4d7015;hp=01793236db22d5c3adc3907a4ad2b2c9f4a679d5;hpb=d32faaf3b401b4c02872bfb2f57e48e11b3a1d28;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index 0179323..8b5fccb 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -29,10 +29,8 @@ #include "EXTERN.h" #define PERL_IN_PP_SYS_C #include "perl.h" -#if !defined(PERL_MICRO) && defined(Quad_t) -# include "time64.h" -# include "time64.c" -#endif +#include "time64.h" +#include "time64.c" #ifdef I_SHADOW /* Shadow password support for solaris - pdo@cs.umd.edu @@ -244,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 @@ -290,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; } @@ -322,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); } @@ -368,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) { @@ -393,7 +389,7 @@ PP(pp_glob) #endif /* !DOSISH */ result = do_readline(); - LEAVE; + LEAVE_with_name("glob"); return result; } @@ -501,6 +497,7 @@ PP(pp_die) tmpsv = newSVpvs_flags("Died", SVs_TEMP); DIE(aTHX_ "%"SVf, SVfARG(tmpsv)); + RETURN; } /* I/O. */ @@ -525,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) { @@ -536,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; } @@ -576,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; } @@ -645,6 +643,7 @@ badexit: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_func, "pipe"); + return NORMAL; #endif } @@ -666,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; } @@ -741,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; } @@ -786,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; @@ -821,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); @@ -841,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); @@ -864,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; @@ -891,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 ) ; } } } @@ -934,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); @@ -1022,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); @@ -1143,6 +1141,7 @@ PP(pp_sselect) RETURN; #else DIE(aTHX_ "select not implemented"); + return NORMAL; #endif } @@ -1162,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; } @@ -1273,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; @@ -1421,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); @@ -1923,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"); } @@ -2094,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) ); @@ -2357,6 +2360,7 @@ PP(pp_flock) RETURN; #else DIE(aTHX_ PL_no_func, "flock()"); + return NORMAL; #endif } @@ -2409,6 +2413,7 @@ PP(pp_socket) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "socket"); + return NORMAL; #endif } @@ -2470,6 +2475,7 @@ PP(pp_sockpair) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "socketpair"); + return NORMAL; #endif } @@ -2501,6 +2507,7 @@ nuts: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_sock_func, "bind"); + return NORMAL; #endif } @@ -2531,6 +2538,7 @@ nuts: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_sock_func, "connect"); + return NORMAL; #endif } @@ -2557,6 +2565,7 @@ nuts: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_sock_func, "listen"); + return NORMAL; #endif } @@ -2636,6 +2645,7 @@ badexit: #else DIE(aTHX_ PL_no_sock_func, "accept"); + return NORMAL; #endif } @@ -2660,6 +2670,7 @@ nuts: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_sock_func, "shutdown"); + return NORMAL; #endif } @@ -2737,6 +2748,7 @@ nuts2: #else DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); + return NORMAL; #endif } @@ -2801,6 +2813,7 @@ nuts2: #else DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); + return NORMAL; #endif } @@ -2820,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"); } @@ -3556,6 +3568,7 @@ PP(pp_chroot) RETURN; #else DIE(aTHX_ PL_no_func, "chroot"); + return NORMAL; #endif } @@ -3630,6 +3643,7 @@ PP(pp_link) { /* Have neither. */ DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); + return NORMAL; } #endif @@ -3829,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))) @@ -3844,6 +3859,7 @@ nope: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "opendir"); + return NORMAL; #endif } @@ -3851,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 *); @@ -3865,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; } @@ -3918,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; } @@ -3933,6 +3946,7 @@ nope: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "telldir"); + return NORMAL; #endif } @@ -3945,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); @@ -3960,6 +3972,7 @@ nope: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "seekdir"); + return NORMAL; #endif } @@ -3971,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)); @@ -3985,6 +3996,7 @@ nope: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "rewinddir"); + return NORMAL; #endif } @@ -3996,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 @@ -4019,6 +4029,7 @@ nope: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "closedir"); + return NORMAL; #endif } @@ -4065,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; @@ -4094,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; @@ -4124,6 +4137,7 @@ PP(pp_waitpid) RETURN; #else DIE(aTHX_ PL_no_func, "waitpid"); + return NORMAL; #endif } @@ -4329,6 +4343,7 @@ PP(pp_getppid) RETURN; #else DIE(aTHX_ PL_no_func, "getppid"); + return NORMAL; #endif } @@ -4350,6 +4365,7 @@ PP(pp_getpgrp) RETURN; #else DIE(aTHX_ PL_no_func, "getpgrp()"); + return NORMAL; #endif } @@ -4383,6 +4399,7 @@ PP(pp_setpgrp) RETURN; #else DIE(aTHX_ PL_no_func, "setpgrp()"); + return NORMAL; #endif } @@ -4396,6 +4413,7 @@ PP(pp_getpriority) RETURN; #else DIE(aTHX_ PL_no_func, "getpriority()"); + return NORMAL; #endif } @@ -4411,6 +4429,7 @@ PP(pp_setpriority) RETURN; #else DIE(aTHX_ PL_no_func, "setpriority()"); + return NORMAL; #endif } @@ -4461,6 +4480,7 @@ PP(pp_tms) RETURN; # else DIE(aTHX_ "times not implemented"); + return NORMAL; # endif #endif /* HAS_TIMES */ } @@ -4469,15 +4489,9 @@ PP(pp_gmtime) { dVAR; dSP; -#if defined(PERL_MICRO) || !defined(Quad_t) - Time_t when; - const struct tm *err; - struct tm tmbuf; -#else Time64_T when; struct TM tmbuf; struct TM *err; -#endif const char *opname = PL_op->op_type == OP_LOCALTIME ? "localtime" : "gmtime"; static const char * const dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; @@ -4485,35 +4499,17 @@ PP(pp_gmtime) {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; -#if defined(PERL_MICRO) || !defined(Quad_t) - if (MAXARG < 1) - (void)time(&when); - else - when = (Time_t)SvIVx(POPs); - - if (PL_op->op_type == OP_LOCALTIME) - err = localtime(&when); - else - err = gmtime(&when); - - if (!err) - tmbuf = *err; -#else if (MAXARG < 1) { time_t now; (void)time(&now); 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 = Perl_floor(POPn); when = (Time64_T)input; - if (when != input && ckWARN(WARN_OVERFLOW)) { - 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); } } @@ -4521,12 +4517,11 @@ PP(pp_gmtime) err = S_localtime64_r(&when, &tmbuf); else err = S_gmtime64_r(&when, &tmbuf); -#endif - if (err == NULL && ckWARN(WARN_OVERFLOW)) { + 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 */ @@ -4582,6 +4577,7 @@ PP(pp_alarm) RETURN; #else DIE(aTHX_ PL_no_func, "alarm"); + return NORMAL; #endif } @@ -4651,6 +4647,7 @@ PP(pp_semget) RETURN; #else DIE(aTHX_ "System V IPC is not implemented on this machine"); + return NORMAL; #endif } @@ -4711,7 +4708,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); @@ -4786,6 +4783,7 @@ PP(pp_ghostent) RETURN; #else DIE(aTHX_ PL_no_sock_func, "gethostent"); + return NORMAL; #endif } @@ -4859,6 +4857,7 @@ PP(pp_gnetent) RETURN; #else DIE(aTHX_ PL_no_sock_func, "getnetent"); + return NORMAL; #endif } @@ -4919,6 +4918,7 @@ PP(pp_gprotoent) RETURN; #else DIE(aTHX_ PL_no_sock_func, "getprotoent"); + return NORMAL; #endif } @@ -4994,6 +4994,7 @@ PP(pp_gservent) RETURN; #else DIE(aTHX_ PL_no_sock_func, "getservent"); + return NORMAL; #endif } @@ -5005,6 +5006,7 @@ PP(pp_shostent) RETSETYES; #else DIE(aTHX_ PL_no_sock_func, "sethostent"); + return NORMAL; #endif } @@ -5016,6 +5018,7 @@ PP(pp_snetent) RETSETYES; #else DIE(aTHX_ PL_no_sock_func, "setnetent"); + return NORMAL; #endif } @@ -5027,6 +5030,7 @@ PP(pp_sprotoent) RETSETYES; #else DIE(aTHX_ PL_no_sock_func, "setprotoent"); + return NORMAL; #endif } @@ -5038,6 +5042,7 @@ PP(pp_sservent) RETSETYES; #else DIE(aTHX_ PL_no_sock_func, "setservent"); + return NORMAL; #endif } @@ -5050,6 +5055,7 @@ PP(pp_ehostent) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "endhostent"); + return NORMAL; #endif } @@ -5062,6 +5068,7 @@ PP(pp_enetent) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "endnetent"); + return NORMAL; #endif } @@ -5074,6 +5081,7 @@ PP(pp_eprotoent) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "endprotoent"); + return NORMAL; #endif } @@ -5086,6 +5094,7 @@ PP(pp_eservent) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "endservent"); + return NORMAL; #endif } @@ -5319,6 +5328,7 @@ PP(pp_gpwent) RETURN; #else DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); + return NORMAL; #endif } @@ -5330,6 +5340,7 @@ PP(pp_spwent) RETPUSHYES; #else DIE(aTHX_ PL_no_func, "setpwent"); + return NORMAL; #endif } @@ -5341,6 +5352,7 @@ PP(pp_epwent) RETPUSHYES; #else DIE(aTHX_ PL_no_func, "endpwent"); + return NORMAL; #endif } @@ -5415,6 +5427,7 @@ PP(pp_ggrent) RETURN; #else DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); + return NORMAL; #endif } @@ -5426,6 +5439,7 @@ PP(pp_sgrent) RETPUSHYES; #else DIE(aTHX_ PL_no_func, "setgrent"); + return NORMAL; #endif } @@ -5437,6 +5451,7 @@ PP(pp_egrent) RETPUSHYES; #else DIE(aTHX_ PL_no_func, "endgrent"); + return NORMAL; #endif } @@ -5452,6 +5467,7 @@ PP(pp_getlogin) RETURN; #else DIE(aTHX_ PL_no_func, "getlogin"); + return NORMAL; #endif } @@ -5550,6 +5566,7 @@ PP(pp_syscall) RETURN; #else DIE(aTHX_ PL_no_func, "syscall"); + return NORMAL; #endif } @@ -5562,6 +5579,7 @@ PP(pp_syscall) static int fcntl_emulate_flock(int fd, int operation) { + int res; struct flock flock; switch (operation & ~LOCK_NB) { @@ -5581,7 +5599,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 */