X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a8cb02613db44c6c8a53ff84a0d959222f9c694f..fd9e8b45c89ee5d36539a3655dae7737fb78c21e:/pp_sys.c diff --git a/pp_sys.c b/pp_sys.c index 225b55e..bea4b7d 100644 --- 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; } @@ -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 ) ; } } } @@ -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; } @@ -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"); } @@ -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,6 +4480,7 @@ PP(pp_tms) RETURN; # else DIE(aTHX_ "times not implemented"); + return NORMAL; # endif #endif /* HAS_TIMES */ } @@ -4438,27 +4505,23 @@ 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); + err = S_localtime64_r(&when, &tmbuf); else - err = gmtime64_r(&when, &tmbuf); + 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 +4577,7 @@ PP(pp_alarm) RETURN; #else DIE(aTHX_ PL_no_func, "alarm"); + return NORMAL; #endif } @@ -4583,6 +4647,7 @@ PP(pp_semget) RETURN; #else DIE(aTHX_ "System V IPC is not implemented on this machine"); + return NORMAL; #endif } @@ -4718,6 +4783,7 @@ PP(pp_ghostent) RETURN; #else DIE(aTHX_ PL_no_sock_func, "gethostent"); + return NORMAL; #endif } @@ -4791,6 +4857,7 @@ PP(pp_gnetent) RETURN; #else DIE(aTHX_ PL_no_sock_func, "getnetent"); + return NORMAL; #endif } @@ -4851,6 +4918,7 @@ PP(pp_gprotoent) RETURN; #else DIE(aTHX_ PL_no_sock_func, "getprotoent"); + return NORMAL; #endif } @@ -4926,6 +4994,7 @@ PP(pp_gservent) RETURN; #else DIE(aTHX_ PL_no_sock_func, "getservent"); + return NORMAL; #endif } @@ -4937,6 +5006,7 @@ PP(pp_shostent) RETSETYES; #else DIE(aTHX_ PL_no_sock_func, "sethostent"); + return NORMAL; #endif } @@ -4948,6 +5018,7 @@ PP(pp_snetent) RETSETYES; #else DIE(aTHX_ PL_no_sock_func, "setnetent"); + return NORMAL; #endif } @@ -4959,6 +5030,7 @@ PP(pp_sprotoent) RETSETYES; #else DIE(aTHX_ PL_no_sock_func, "setprotoent"); + return NORMAL; #endif } @@ -4970,6 +5042,7 @@ PP(pp_sservent) RETSETYES; #else DIE(aTHX_ PL_no_sock_func, "setservent"); + return NORMAL; #endif } @@ -4982,6 +5055,7 @@ PP(pp_ehostent) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "endhostent"); + return NORMAL; #endif } @@ -4994,6 +5068,7 @@ PP(pp_enetent) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "endnetent"); + return NORMAL; #endif } @@ -5006,6 +5081,7 @@ PP(pp_eprotoent) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "endprotoent"); + return NORMAL; #endif } @@ -5018,6 +5094,7 @@ PP(pp_eservent) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "endservent"); + return NORMAL; #endif } @@ -5251,6 +5328,7 @@ PP(pp_gpwent) RETURN; #else DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); + return NORMAL; #endif } @@ -5262,6 +5340,7 @@ PP(pp_spwent) RETPUSHYES; #else DIE(aTHX_ PL_no_func, "setpwent"); + return NORMAL; #endif } @@ -5273,6 +5352,7 @@ PP(pp_epwent) RETPUSHYES; #else DIE(aTHX_ PL_no_func, "endpwent"); + return NORMAL; #endif } @@ -5305,7 +5385,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 +5405,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 +5427,7 @@ PP(pp_ggrent) RETURN; #else DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); + return NORMAL; #endif } @@ -5350,6 +5439,7 @@ PP(pp_sgrent) RETPUSHYES; #else DIE(aTHX_ PL_no_func, "setgrent"); + return NORMAL; #endif } @@ -5361,6 +5451,7 @@ PP(pp_egrent) RETPUSHYES; #else DIE(aTHX_ PL_no_func, "endgrent"); + return NORMAL; #endif } @@ -5376,6 +5467,7 @@ PP(pp_getlogin) RETURN; #else DIE(aTHX_ PL_no_func, "getlogin"); + return NORMAL; #endif } @@ -5474,6 +5566,7 @@ PP(pp_syscall) RETURN; #else DIE(aTHX_ PL_no_func, "syscall"); + return NORMAL; #endif } @@ -5486,6 +5579,7 @@ PP(pp_syscall) static int fcntl_emulate_flock(int fd, int operation) { + int res; struct flock flock; switch (operation & ~LOCK_NB) { @@ -5505,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 */