X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/af51a00e97d5c55987039f94df86e106c0d31ef5..faceb03c4aa634b15ae4628ae2c45c11734e2fd7:/pp_sys.c diff --git a/pp_sys.c b/pp_sys.c index fd3b368..65971c1 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -197,9 +197,7 @@ void setservent(int); void endservent(void); #endif -#undef PERL_EFF_ACCESS_R_OK /* EFFective uid/gid ACCESS R_OK */ -#undef PERL_EFF_ACCESS_W_OK -#undef PERL_EFF_ACCESS_X_OK +#undef PERL_EFF_ACCESS /* EFFective uid/gid ACCESS */ /* AIX 5.2 and below use mktime for localtime, and defines the edge case * for time 0x7fffffff to be valid only in UTC. AIX 5.3 provides localtime64 @@ -212,38 +210,31 @@ void endservent(void); /* F_OK unused: if stat() cannot find it... */ -#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESS) && defined(EFF_ONLY_OK) && !defined(NO_EFF_ONLY_OK) +#if !defined(PERL_EFF_ACCESS) && defined(HAS_ACCESS) && defined(EFF_ONLY_OK) && !defined(NO_EFF_ONLY_OK) /* Digital UNIX (when the EFF_ONLY_OK gets fixed), UnixWare */ -# define PERL_EFF_ACCESS_R_OK(p) (access((p), R_OK | EFF_ONLY_OK)) -# define PERL_EFF_ACCESS_W_OK(p) (access((p), W_OK | EFF_ONLY_OK)) -# define PERL_EFF_ACCESS_X_OK(p) (access((p), X_OK | EFF_ONLY_OK)) +# define PERL_EFF_ACCESS(p,f) (access((p), (f) | EFF_ONLY_OK)) #endif -#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_EACCESS) +#if !defined(PERL_EFF_ACCESS) && defined(HAS_EACCESS) # ifdef I_SYS_SECURITY # include # endif # ifdef ACC_SELF /* HP SecureWare */ -# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF)) -# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF)) -# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF)) +# define PERL_EFF_ACCESS(p,f) (eaccess((p), (f), ACC_SELF)) # else /* SCO */ -# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK)) -# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK)) -# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK)) +# define PERL_EFF_ACCESS(p,f) (eaccess((p), (f))) # endif #endif -#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF) +#if !defined(PERL_EFF_ACCESS) && defined(HAS_ACCESSX) && defined(ACC_SELF) /* AIX */ -# define PERL_EFF_ACCESS_R_OK(p) (accessx((p), R_OK, ACC_SELF)) -# define PERL_EFF_ACCESS_W_OK(p) (accessx((p), W_OK, ACC_SELF)) -# define PERL_EFF_ACCESS_X_OK(p) (accessx((p), X_OK, ACC_SELF)) +# define PERL_EFF_ACCESS(p,f) (accessx((p), (f), ACC_SELF)) #endif -#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESS) \ + +#if !defined(PERL_EFF_ACCESS) && defined(HAS_ACCESS) \ && (defined(HAS_SETREUID) || defined(HAS_SETRESUID) \ || defined(HAS_SETREGID) || defined(HAS_SETRESGID)) /* The Hard Way. */ @@ -306,12 +297,10 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) return res; } -# define PERL_EFF_ACCESS_R_OK(p) (emulate_eaccess((p), R_OK)) -# define PERL_EFF_ACCESS_W_OK(p) (emulate_eaccess((p), W_OK)) -# define PERL_EFF_ACCESS_X_OK(p) (emulate_eaccess((p), X_OK)) +# define PERL_EFF_ACCESS(p,f) (emulate_eaccess((p), (f))) #endif -#if !defined(PERL_EFF_ACCESS_R_OK) +#if !defined(PERL_EFF_ACCESS) /* With it or without it: anyway you get a warning: either that it is unused, or it is declared static and never defined. */ @@ -341,10 +330,7 @@ PP(pp_backtick) mode = "rt"; fp = PerlProc_popen(tmps, mode); if (fp) { - const char *type = NULL; - if (PL_curcop->cop_io) { - type = SvPV_nolen_const(PL_curcop->cop_io); - } + const char * const type = PL_curcop->cop_io ? SvPV_nolen_const(PL_curcop->cop_io) : NULL; if (type && *type) PerlIO_apply_layers(aTHX_ fp,mode,type); @@ -441,12 +427,16 @@ PP(pp_warn) SV *tmpsv; const char *tmps; STRLEN len; - if (SP - MARK != 1) { + if (SP - MARK > 1) { dTARGET; do_join(TARG, &PL_sv_no, MARK, SP); tmpsv = TARG; SP = MARK + 1; } + else if (SP == MARK) { + tmpsv = &PL_sv_no; + EXTEND(SP, 1); + } else { tmpsv = TOPs; } @@ -489,17 +479,17 @@ PP(pp_die) tmps = SvROK(tmpsv) ? Nullch : SvPV_const(tmpsv, len); } if (!tmps || !len) { - SV *error = ERRSV; + 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 *stash = SvSTASH(SvRV(error)); - GV *gv = gv_fetchmethod(stash, "PROPAGATE"); + HV * const stash = SvSTASH(SvRV(error)); + GV * const gv = gv_fetchmethod(stash, "PROPAGATE"); if (gv) { - SV *file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0)); - SV *line = sv_2mortal(newSVuv(CopLINE(PL_curcop))); + 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); @@ -987,11 +977,6 @@ PP(pp_dbmopen) RETURN; } -PP(pp_dbmclose) -{ - return pp_untie(); -} - PP(pp_sselect) { #ifdef HAS_SELECT @@ -1170,12 +1155,10 @@ Perl_setdefout(pTHX_ GV *gv) PP(pp_select) { dSP; dTARGET; - GV *egv; HV *hv; - GV * const newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL; + GV * egv = GvEGV(PL_defoutgv); - egv = GvEGV(PL_defoutgv); if (!egv) egv = PL_defoutgv; hv = GvSTASH(egv); @@ -1247,11 +1230,6 @@ PP(pp_getc) RETURN; } -PP(pp_read) -{ - return pp_sysread(); -} - STATIC OP * S_doform(pTHX_ CV *cv, GV *gv, OP *retop) { @@ -1789,41 +1767,34 @@ PP(pp_sysread) RETPUSHUNDEF; } -PP(pp_syswrite) -{ - dVAR; dSP; - const int items = (SP - PL_stack_base) - TOPMARK; - if (items == 2) { - SV *sv; - EXTEND(SP, 1); - sv = sv_2mortal(newSViv(sv_len(*SP))); - PUSHs(sv); - PUTBACK; - } - return pp_send(); -} - PP(pp_send) { dVAR; dSP; dMARK; dORIGMARK; dTARGET; - GV *gv; IO *io; SV *bufsv; const char *buffer; - Size_t length; + Size_t length = 0; SSize_t retval; STRLEN blen; MAGIC *mg; - - gv = (GV*)*++MARK; + const int op_type = PL_op->op_type; + + GV *const gv = (GV*)*++MARK; if (PL_op->op_type == OP_SYSWRITE && gv && (io = GvIO(gv)) && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) { SV *sv; + + if (MARK == SP - 1) { + EXTEND(SP, 1000); + sv = sv_2mortal(newSViv(sv_len(*SP))); + PUSHs(sv); + PUTBACK; + } - PUSHMARK(MARK-1); - *MARK = SvTIED_obj((SV*)io, mg); + PUSHMARK(ORIGMARK); + *(ORIGMARK+1) = SvTIED_obj((SV*)io, mg); ENTER; call_method("WRITE", G_SCALAR); LEAVE; @@ -1835,14 +1806,22 @@ PP(pp_send) } if (!gv) goto say_undef; + bufsv = *++MARK; + + if (op_type == OP_SYSWRITE) { + if (MARK >= SP) { + length = (Size_t) sv_len(bufsv); + } else { #if Size_t_size > IVSIZE - length = (Size_t)SvNVx(*++MARK); + length = (Size_t)SvNVx(*++MARK); #else - length = (Size_t)SvIVx(*++MARK); + length = (Size_t)SvIVx(*++MARK); #endif - if ((SSize_t)length < 0) - DIE(aTHX_ "Negative length"); + if ((SSize_t)length < 0) + DIE(aTHX_ "Negative length"); + } + } SETERRNO(0,0); io = GvIO(gv); if (!io || !IoIFP(io)) { @@ -1869,7 +1848,7 @@ PP(pp_send) buffer = SvPV_const(bufsv, blen); } - if (PL_op->op_type == OP_SYSWRITE) { + if (op_type == OP_SYSWRITE) { IV offset; if (DO_UTF8(bufsv)) { /* length and offset are in chars */ @@ -1908,16 +1887,19 @@ PP(pp_send) } } #ifdef HAS_SOCKET - else if (SP > MARK) { - STRLEN mlen; - char * const sockbuf = SvPVx(*++MARK, mlen); - /* length is really flags */ - retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, - length, (struct sockaddr *)sockbuf, mlen); + else { + const int flags = SvIVx(*++MARK); + if (SP > MARK) { + STRLEN mlen; + char * const sockbuf = SvPVx(*++MARK, mlen); + retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, + flags, (struct sockaddr *)sockbuf, mlen); + } + else { + retval + = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags); + } } - else - /* length is really flags */ - retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length); #else else DIE(aTHX_ PL_no_sock_func, "send"); @@ -1939,11 +1921,6 @@ PP(pp_send) RETPUSHUNDEF; } -PP(pp_recv) -{ - return pp_sysread(); -} - PP(pp_eof) { dVAR; dSP; @@ -2023,25 +2000,19 @@ PP(pp_tell) RETURN; } -PP(pp_seek) -{ - return pp_sysseek(); -} - PP(pp_sysseek) { dVAR; dSP; - GV *gv; IO *io; const int whence = POPi; #if LSEEKSIZE > IVSIZE - Off_t offset = (Off_t)SvNVx(POPs); + const Off_t offset = (Off_t)SvNVx(POPs); #else - Off_t offset = (Off_t)SvIVx(POPs); + const Off_t offset = (Off_t)SvIVx(POPs); #endif MAGIC *mg; - gv = PL_last_in_gv = (GV*)POPs; + GV * const gv = PL_last_in_gv = (GV*)POPs; if (gv && (io = GvIO(gv)) && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) @@ -2065,11 +2036,11 @@ PP(pp_sysseek) if (PL_op->op_type == OP_SEEK) PUSHs(boolSV(do_seek(gv, offset, whence))); else { - Off_t sought = do_sysseek(gv, offset, whence); + const Off_t sought = do_sysseek(gv, offset, whence); if (sought < 0) PUSHs(&PL_sv_undef); else { - SV* sv = sought ? + SV* const sv = sought ? #if LSEEKSIZE > IVSIZE newSVnv((NV)sought) #else @@ -2132,7 +2103,7 @@ PP(pp_truncate) } } else { - SV *sv = POPs; + SV * const sv = POPs; const char *name; if (SvTYPE(sv) == SVt_PVGV) { @@ -2155,9 +2126,9 @@ PP(pp_truncate) result = 0; #else { - int tmpfd; + const int tmpfd = PerlLIO_open(name, O_RDWR); - if ((tmpfd = PerlLIO_open(name, O_RDWR)) < 0) + if (tmpfd < 0) result = 0; else { if (my_chsize(tmpfd, len) < 0) @@ -2176,21 +2147,16 @@ PP(pp_truncate) } } -PP(pp_fcntl) -{ - return pp_ioctl(); -} - PP(pp_ioctl) { dSP; dTARGET; - SV *argsv = POPs; + SV * const argsv = POPs; const unsigned int func = POPu; const int optype = PL_op->op_type; + GV * const gv = (GV*)POPs; + IO * const io = gv ? GvIOn(gv) : Null(IO*); char *s; IV retval; - GV *gv = (GV*)POPs; - IO *io = gv ? GvIOn(gv) : 0; if (!io || !argsv || !IoIFP(io)) { if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) @@ -2261,22 +2227,18 @@ PP(pp_flock) #ifdef FLOCK dSP; dTARGET; I32 value; - int argtype; - GV *gv; IO *io = NULL; PerlIO *fp; + const int argtype = POPi; + GV * const gv = (MAXARG == 0) ? PL_last_in_gv : (GV*)POPs; - argtype = POPi; - if (MAXARG == 0) - gv = PL_last_in_gv; - else - gv = (GV*)POPs; if (gv && (io = GvIO(gv))) fp = IoIFP(io); else { fp = Nullfp; io = NULL; } + /* XXX Looks to me like io is always NULL at this point */ if (fp) { (void)PerlIO_flush(fp); value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0); @@ -2300,16 +2262,13 @@ PP(pp_socket) { #ifdef HAS_SOCKET dSP; - GV *gv; - register IO *io; - int protocol = POPi; - int type = POPi; - int domain = POPi; + const int protocol = POPi; + const int type = POPi; + const int domain = POPi; + GV * const gv = (GV*)POPs; + register IO * const io = gv ? GvIOn(gv) : NULL; int fd; - gv = (GV*)POPs; - io = gv ? GvIOn(gv) : NULL; - if (!gv || !io) { if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); @@ -2353,19 +2312,15 @@ PP(pp_sockpair) { #if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET)) dSP; - GV *gv1; - GV *gv2; - register IO *io1; - register IO *io2; - int protocol = POPi; - int type = POPi; - int domain = POPi; + const int protocol = POPi; + const int type = POPi; + const int domain = POPi; + GV * const gv2 = (GV*)POPs; + GV * const gv1 = (GV*)POPs; + register IO * const io1 = gv1 ? GvIOn(gv1) : NULL; + register IO * const io2 = gv2 ? GvIOn(gv2) : NULL; int fd[2]; - gv2 = (GV*)POPs; - gv1 = (GV*)POPs; - io1 = gv1 ? GvIOn(gv1) : NULL; - io2 = gv2 ? GvIOn(gv2) : NULL; if (!gv1 || !gv2 || !io1 || !io2) { if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) { if (!gv1 || !io1) @@ -2422,11 +2377,11 @@ PP(pp_bind) extern void GETPRIVMODE(); extern void GETUSERMODE(); #endif - SV *addrsv = POPs; + SV * const addrsv = POPs; /* OK, so on what platform does bind modify addr? */ const char *addr; - GV *gv = (GV*)POPs; - register IO *io = GvIOn(gv); + GV * const gv = (GV*)POPs; + register IO * const io = GvIOn(gv); STRLEN len; int bind_ok = 0; #ifdef MPE @@ -2478,10 +2433,10 @@ PP(pp_connect) { #ifdef HAS_SOCKET dSP; - SV *addrsv = POPs; + SV * const addrsv = POPs; + GV * const gv = (GV*)POPs; + register IO * const io = GvIOn(gv); const char *addr; - GV *gv = (GV*)POPs; - register IO *io = GvIOn(gv); STRLEN len; if (!io || !IoIFP(io)) @@ -2508,9 +2463,9 @@ PP(pp_listen) { #ifdef HAS_SOCKET dSP; - int backlog = POPi; - GV *gv = (GV*)POPs; - register IO *io = gv ? GvIOn(gv) : NULL; + const int backlog = POPi; + GV * const gv = (GV*)POPs; + register IO * const io = gv ? GvIOn(gv) : NULL; if (!gv || !io || !IoIFP(io)) goto nuts; @@ -2534,8 +2489,6 @@ PP(pp_accept) { #ifdef HAS_SOCKET dSP; dTARGET; - GV *ngv; - GV *ggv; register IO *nstio; register IO *gstio; char namebuf[MAXPATHLEN]; @@ -2544,11 +2497,10 @@ PP(pp_accept) #else Sock_size_t len = sizeof namebuf; #endif + GV * const ggv = (GV*)POPs; + GV * const ngv = (GV*)POPs; int fd; - ggv = (GV*)POPs; - ngv = (GV*)POPs; - if (!ngv) goto badexit; if (!ggv) @@ -2605,9 +2557,9 @@ PP(pp_shutdown) { #ifdef HAS_SOCKET dSP; dTARGET; - int how = POPi; - GV *gv = (GV*)POPs; - register IO *io = GvIOn(gv); + const int how = POPi; + GV * const gv = (GV*)POPs; + register IO * const io = GvIOn(gv); if (!io || !IoIFP(io)) goto nuts; @@ -2625,33 +2577,19 @@ nuts: #endif } -PP(pp_gsockopt) -{ - return pp_ssockopt(); -} - PP(pp_ssockopt) { #ifdef HAS_SOCKET dSP; - int optype = PL_op->op_type; - SV *sv; + const int optype = PL_op->op_type; + SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(NEWSV(22, 257)) : POPs; + const unsigned int optname = (unsigned int) POPi; + const unsigned int lvl = (unsigned int) POPi; + GV * const gv = (GV*)POPs; + register IO * const io = GvIOn(gv); int fd; - unsigned int optname; - unsigned int lvl; - GV *gv; - register IO *io; Sock_size_t len; - if (optype == OP_GSOCKOPT) - sv = sv_2mortal(NEWSV(22, 257)); - else - sv = POPs; - optname = (unsigned int) POPi; - lvl = (unsigned int) POPi; - - gv = (GV*)POPs; - io = GvIOn(gv); if (!io || !IoIFP(io)) goto nuts; @@ -2716,21 +2654,16 @@ nuts2: #endif } -PP(pp_getsockname) -{ - return pp_getpeername(); -} - PP(pp_getpeername) { #ifdef HAS_SOCKET dSP; - int optype = PL_op->op_type; + const int optype = PL_op->op_type; + GV * const gv = (GV*)POPs; + register IO * const io = GvIOn(gv); + Sock_size_t len; SV *sv; int fd; - GV *gv = (GV*)POPs; - register IO *io = GvIOn(gv); - Sock_size_t len; if (!io || !IoIFP(io)) goto nuts; @@ -2787,11 +2720,6 @@ nuts2: /* Stat calls. */ -PP(pp_lstat) -{ - return pp_stat(); -} - PP(pp_stat) { dSP; @@ -2803,6 +2731,7 @@ PP(pp_stat) gv = cGVOP_gv; 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", GvENAME(gv)); @@ -2825,16 +2754,15 @@ PP(pp_stat) } } else { - SV* sv = POPs; + SV* const sv = POPs; if (SvTYPE(sv) == SVt_PVGV) { gv = (GV*)sv; goto do_fstat; } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { gv = (GV*)SvRV(sv); - if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO)) - Perl_warner(aTHX_ packWARN(WARN_IO), - "lstat() on filehandle %s", GvENAME(gv)); + if (PL_op->op_type == OP_LSTAT) + goto do_fstat_warning_check; goto do_fstat; } sv_setpv(PL_statname, SvPV_nolen_const(sv)); @@ -2924,410 +2852,247 @@ PP(pp_stat) PP(pp_ftrread) { I32 result; - dSP; - STACKED_FTEST_CHECK; -#if defined(HAS_ACCESS) && defined(R_OK) - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = access(POPpx, R_OK); - if (result == 0) - RETPUSHYES; - if (result < 0) - RETPUSHUNDEF; - RETPUSHNO; - } - else - result = my_stat(); + /* Not const, because things tweak this below. Not bool, because there's + no guarantee that OPp_FT_ACCESS is <= CHAR_MAX */ +#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS) + I32 use_access = PL_op->op_private & OPpFT_ACCESS; + /* Giving some sort of initial value silences compilers. */ +# ifdef R_OK + int access_mode = R_OK; +# else + int access_mode = 0; +# endif #else - result = my_stat(); + /* access_mode is never used, but leaving use_access in makes the + conditional compiling below much clearer. */ + I32 use_access = 0; #endif - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (cando(S_IRUSR, 0, &PL_statcache)) - RETPUSHYES; - RETPUSHNO; -} + int stat_mode = S_IRUSR; -PP(pp_ftrwrite) -{ - I32 result; + bool effective = FALSE; dSP; + STACKED_FTEST_CHECK; + + switch (PL_op->op_type) { + case OP_FTRREAD: +#if !(defined(HAS_ACCESS) && defined(R_OK)) + use_access = 0; +#endif + break; + + case OP_FTRWRITE: #if defined(HAS_ACCESS) && defined(W_OK) - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = access(POPpx, W_OK); - if (result == 0) - RETPUSHYES; - if (result < 0) - RETPUSHUNDEF; - RETPUSHNO; - } - else - result = my_stat(); + access_mode = W_OK; #else - result = my_stat(); + use_access = 0; #endif - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (cando(S_IWUSR, 0, &PL_statcache)) - RETPUSHYES; - RETPUSHNO; -} + stat_mode = S_IWUSR; + break; -PP(pp_ftrexec) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; + case OP_FTREXEC: #if defined(HAS_ACCESS) && defined(X_OK) - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = access(POPpx, X_OK); - if (result == 0) - RETPUSHYES; - if (result < 0) - RETPUSHUNDEF; - RETPUSHNO; - } - else - result = my_stat(); + access_mode = X_OK; #else - result = my_stat(); + use_access = 0; #endif - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (cando(S_IXUSR, 0, &PL_statcache)) - RETPUSHYES; - RETPUSHNO; -} + stat_mode = S_IXUSR; + break; -PP(pp_fteread) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; -#ifdef PERL_EFF_ACCESS_R_OK - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = PERL_EFF_ACCESS_R_OK(POPpx); - if (result == 0) - RETPUSHYES; - if (result < 0) - RETPUSHUNDEF; - RETPUSHNO; - } - else - result = my_stat(); + case OP_FTEWRITE: +#ifdef PERL_EFF_ACCESS + access_mode = W_OK; +#endif + stat_mode = S_IWUSR; + /* Fall through */ + + case OP_FTEREAD: +#ifndef PERL_EFF_ACCESS + use_access = 0; +#endif + effective = TRUE; + break; + + + case OP_FTEEXEC: +#ifdef PERL_EFF_ACCESS + access_mode = W_OK; #else - result = my_stat(); + use_access = 0; #endif - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (cando(S_IRUSR, 1, &PL_statcache)) - RETPUSHYES; - RETPUSHNO; -} + stat_mode = S_IXUSR; + effective = TRUE; + break; + } -PP(pp_ftewrite) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; -#ifdef PERL_EFF_ACCESS_W_OK - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = PERL_EFF_ACCESS_W_OK(POPpx); + if (use_access) { +#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS) + const char *const name = POPpx; + if (effective) { +# ifdef PERL_EFF_ACCESS + result = PERL_EFF_ACCESS(name, access_mode); +# else + DIE(aTHX_ "panic: attempt to call PERL_EFF_ACCESS in %s", + OP_NAME(PL_op)); +# endif + } + else { +# ifdef HAS_ACCESS + result = access(name, access_mode); +# else + DIE(aTHX_ "panic: attempt to call access() in %s", OP_NAME(PL_op)); +# endif + } if (result == 0) RETPUSHYES; if (result < 0) RETPUSHUNDEF; RETPUSHNO; +#endif } - else - result = my_stat(); -#else + result = my_stat(); -#endif SPAGAIN; if (result < 0) RETPUSHUNDEF; - if (cando(S_IWUSR, 1, &PL_statcache)) + if (cando(stat_mode, effective, &PL_statcache)) RETPUSHYES; RETPUSHNO; } -PP(pp_fteexec) +PP(pp_ftis) { I32 result; + const int op_type = PL_op->op_type; dSP; STACKED_FTEST_CHECK; -#ifdef PERL_EFF_ACCESS_X_OK - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = PERL_EFF_ACCESS_X_OK(POPpx); - if (result == 0) - RETPUSHYES; - if (result < 0) - RETPUSHUNDEF; - RETPUSHNO; - } - else - result = my_stat(); -#else result = my_stat(); -#endif SPAGAIN; if (result < 0) RETPUSHUNDEF; - if (cando(S_IXUSR, 1, &PL_statcache)) + if (op_type == OP_FTIS) RETPUSHYES; - RETPUSHNO; + { + /* You can't dTARGET inside OP_FTIS, because you'll get + "panic: pad_sv po" - the op is not flagged to have a target. */ + dTARGET; + switch (op_type) { + case OP_FTSIZE: +#if Off_t_size > IVSIZE + PUSHn(PL_statcache.st_size); +#else + PUSHi(PL_statcache.st_size); +#endif + break; + case OP_FTMTIME: + PUSHn( (((NV)PL_basetime - PL_statcache.st_mtime)) / 86400.0 ); + break; + case OP_FTATIME: + PUSHn( (((NV)PL_basetime - PL_statcache.st_atime)) / 86400.0 ); + break; + case OP_FTCTIME: + PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 ); + break; + } + } + RETURN; } -PP(pp_ftis) +PP(pp_ftrowned) { I32 result; dSP; + + /* I believe that all these three are likely to be defined on most every + system these days. */ +#ifndef S_ISUID + if(PL_op->op_type == OP_FTSUID) + RETPUSHNO; +#endif +#ifndef S_ISGID + if(PL_op->op_type == OP_FTSGID) + RETPUSHNO; +#endif +#ifndef S_ISVTX + if(PL_op->op_type == OP_FTSVTX) + RETPUSHNO; +#endif + STACKED_FTEST_CHECK; result = my_stat(); SPAGAIN; if (result < 0) RETPUSHUNDEF; - RETPUSHYES; -} - -PP(pp_fteowned) -{ - return pp_ftrowned(); + switch (PL_op->op_type) { + case OP_FTROWNED: + if (PL_statcache.st_uid == PL_uid) + RETPUSHYES; + break; + case OP_FTEOWNED: + if (PL_statcache.st_uid == PL_euid) + RETPUSHYES; + break; + case OP_FTZERO: + if (PL_statcache.st_size == 0) + RETPUSHYES; + break; + case OP_FTSOCK: + if (S_ISSOCK(PL_statcache.st_mode)) + RETPUSHYES; + break; + case OP_FTCHR: + if (S_ISCHR(PL_statcache.st_mode)) + RETPUSHYES; + break; + case OP_FTBLK: + if (S_ISBLK(PL_statcache.st_mode)) + RETPUSHYES; + break; + case OP_FTFILE: + if (S_ISREG(PL_statcache.st_mode)) + RETPUSHYES; + break; + case OP_FTDIR: + if (S_ISDIR(PL_statcache.st_mode)) + RETPUSHYES; + break; + case OP_FTPIPE: + if (S_ISFIFO(PL_statcache.st_mode)) + RETPUSHYES; + break; +#ifdef S_ISUID + case OP_FTSUID: + if (PL_statcache.st_mode & S_ISUID) + RETPUSHYES; + break; +#endif +#ifdef S_ISGID + case OP_FTSGID: + if (PL_statcache.st_mode & S_ISGID) + RETPUSHYES; + break; +#endif +#ifdef S_ISVTX + case OP_FTSVTX: + if (PL_statcache.st_mode & S_ISVTX) + RETPUSHYES; + break; +#endif + } + RETPUSHNO; } -PP(pp_ftrowned) +PP(pp_ftlink) { - I32 result; + I32 result = my_lstat(); dSP; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; if (result < 0) RETPUSHUNDEF; - if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ? - PL_euid : PL_uid) ) + if (S_ISLNK(PL_statcache.st_mode)) RETPUSHYES; RETPUSHNO; } -PP(pp_ftzero) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (PL_statcache.st_size == 0) - RETPUSHYES; - RETPUSHNO; -} - -PP(pp_ftsize) -{ - I32 result; - dSP; dTARGET; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; -#if Off_t_size > IVSIZE - PUSHn(PL_statcache.st_size); -#else - PUSHi(PL_statcache.st_size); -#endif - RETURN; -} - -PP(pp_ftmtime) -{ - I32 result; - dSP; dTARGET; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - PUSHn( (((NV)PL_basetime - PL_statcache.st_mtime)) / 86400.0 ); - RETURN; -} - -PP(pp_ftatime) -{ - I32 result; - dSP; dTARGET; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - PUSHn( (((NV)PL_basetime - PL_statcache.st_atime)) / 86400.0 ); - RETURN; -} - -PP(pp_ftctime) -{ - I32 result; - dSP; dTARGET; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 ); - RETURN; -} - -PP(pp_ftsock) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (S_ISSOCK(PL_statcache.st_mode)) - RETPUSHYES; - RETPUSHNO; -} - -PP(pp_ftchr) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (S_ISCHR(PL_statcache.st_mode)) - RETPUSHYES; - RETPUSHNO; -} - -PP(pp_ftblk) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (S_ISBLK(PL_statcache.st_mode)) - RETPUSHYES; - RETPUSHNO; -} - -PP(pp_ftfile) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (S_ISREG(PL_statcache.st_mode)) - RETPUSHYES; - RETPUSHNO; -} - -PP(pp_ftdir) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (S_ISDIR(PL_statcache.st_mode)) - RETPUSHYES; - RETPUSHNO; -} - -PP(pp_ftpipe) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (S_ISFIFO(PL_statcache.st_mode)) - RETPUSHYES; - RETPUSHNO; -} - -PP(pp_ftlink) -{ - I32 result = my_lstat(); - dSP; - if (result < 0) - RETPUSHUNDEF; - if (S_ISLNK(PL_statcache.st_mode)) - RETPUSHYES; - RETPUSHNO; -} - -PP(pp_ftsuid) -{ - dSP; -#ifdef S_ISUID - I32 result; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (PL_statcache.st_mode & S_ISUID) - RETPUSHYES; -#endif - RETPUSHNO; -} - -PP(pp_ftsgid) -{ - dSP; -#ifdef S_ISGID - I32 result; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (PL_statcache.st_mode & S_ISGID) - RETPUSHYES; -#endif - RETPUSHNO; -} - -PP(pp_ftsvtx) -{ - dSP; -#ifdef S_ISVTX - I32 result; - STACKED_FTEST_CHECK; - result = my_stat(); - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (PL_statcache.st_mode & S_ISVTX) - RETPUSHYES; -#endif - RETPUSHNO; -} - PP(pp_fttty) { dSP; @@ -3526,11 +3291,6 @@ PP(pp_fttext) RETPUSHYES; } -PP(pp_ftbinary) -{ - return pp_fttext(); -} - /* File calls. */ PP(pp_chdir) @@ -3612,23 +3372,19 @@ PP(pp_chdir) PP(pp_chown) { -#ifdef HAS_CHOWN dSP; dMARK; dTARGET; - I32 value = (I32)apply(PL_op->op_type, MARK, SP); + const I32 value = (I32)apply(PL_op->op_type, MARK, SP); SP = MARK; - PUSHi(value); + XPUSHi(value); RETURN; -#else - DIE(aTHX_ PL_no_func, "chown"); -#endif } PP(pp_chroot) { #ifdef HAS_CHROOT dSP; dTARGET; - char *tmps = POPpx; + char * const tmps = POPpx; TAINT_PROPER("chroot"); PUSHi( chroot(tmps) >= 0 ); RETURN; @@ -3637,42 +3393,12 @@ PP(pp_chroot) #endif } -PP(pp_unlink) -{ - dSP; dMARK; dTARGET; - I32 value; - value = (I32)apply(PL_op->op_type, MARK, SP); - SP = MARK; - PUSHi(value); - RETURN; -} - -PP(pp_chmod) -{ - dSP; dMARK; dTARGET; - I32 value; - value = (I32)apply(PL_op->op_type, MARK, SP); - SP = MARK; - PUSHi(value); - RETURN; -} - -PP(pp_utime) -{ - dSP; dMARK; dTARGET; - I32 value; - value = (I32)apply(PL_op->op_type, MARK, SP); - SP = MARK; - PUSHi(value); - RETURN; -} - PP(pp_rename) { dSP; dTARGET; int anum; - const char *tmps2 = POPpconstx; - const char *tmps = SvPV_nolen_const(TOPs); + const char * const tmps2 = POPpconstx; + const char * const tmps = SvPV_nolen_const(TOPs); TAINT_PROPER("rename"); #ifdef HAS_RENAME anum = PerlLIO_rename(tmps, tmps2); @@ -3692,33 +3418,54 @@ PP(pp_rename) RETURN; } +#if defined(HAS_LINK) || defined(HAS_SYMLINK) PP(pp_link) { -#ifdef HAS_LINK dSP; dTARGET; - const char *tmps2 = POPpconstx; - const char *tmps = SvPV_nolen_const(TOPs); - TAINT_PROPER("link"); - SETi( PerlLIO_link(tmps, tmps2) >= 0 ); - RETURN; -#else - DIE(aTHX_ PL_no_func, "link"); -#endif -} + const int op_type = PL_op->op_type; + int result; -PP(pp_symlink) -{ -#ifdef HAS_SYMLINK - dSP; dTARGET; - const char *tmps2 = POPpconstx; - const char *tmps = SvPV_nolen_const(TOPs); - TAINT_PROPER("symlink"); - SETi( symlink(tmps, tmps2) >= 0 ); +# ifndef HAS_LINK + if (op_type == OP_LINK) + DIE(aTHX_ PL_no_func, "link"); +# endif +# ifndef HAS_SYMLINK + if (op_type == OP_SYMLINK) + DIE(aTHX_ PL_no_func, "symlink"); +# endif + + { + const char * const tmps2 = POPpconstx; + const char * const tmps = SvPV_nolen_const(TOPs); + TAINT_PROPER(PL_op_desc[op_type]); + result = +# if defined(HAS_LINK) +# if defined(HAS_SYMLINK) + /* Both present - need to choose which. */ + (op_type == OP_LINK) ? + PerlLIO_link(tmps, tmps2) : symlink(tmps, tmps2); +# else + /* Only have link, so calls to pp_symlink will have DIE()d above. */ + PerlLIO_link(tmps, tmps2); +# endif +# else +# if defined(HAS_SYMLINK) + /* Only have symlink, so calls to pp_link will have DIE()d above. */ + symlink(tmps, tmps2); +# endif +# endif + } + + SETi( result >= 0 ); RETURN; +} #else - DIE(aTHX_ PL_no_func, "symlink"); -#endif +PP(pp_link) +{ + /* Have neither. */ + DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); } +#endif PP(pp_readlink) { @@ -3767,7 +3514,7 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename) Safefree(cmdline); if (myfp) { - SV *tmpsv = sv_newmortal(); + SV * const tmpsv = sv_newmortal(); /* Need to save/restore 'PL_rs' ?? */ s = sv_gets(tmpsv, myfp, 0); (void)PerlProc_pclose(myfp); @@ -3855,18 +3602,10 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename) PP(pp_mkdir) { dSP; dTARGET; - int mode; -#ifndef HAS_MKDIR - int oldumask; -#endif STRLEN len; const char *tmps; bool copy = FALSE; - - if (MAXARG > 1) - mode = POPi; - else - mode = 0777; + const int mode = (MAXARG > 1) ? POPi : 0777; TRIMSLASHES(tmps,len,copy); @@ -3874,10 +3613,13 @@ PP(pp_mkdir) #ifdef HAS_MKDIR SETi( PerlDir_mkdir(tmps, mode) >= 0 ); #else + { + int oldumask; SETi( dooneliner("mkdir", tmps) ); oldumask = PerlLIO_umask(0); PerlLIO_umask(oldumask); PerlLIO_chmod(tmps, (mode & ~oldumask) & 0777); + } #endif if (copy) Safefree(tmps); @@ -3909,9 +3651,9 @@ PP(pp_open_dir) { #if defined(Direntry_t) && defined(HAS_READDIR) dSP; - const char *dirname = POPpconstx; - GV *gv = (GV*)POPs; - register IO *io = GvIOn(gv); + const char * const dirname = POPpconstx; + GV * const gv = (GV*)POPs; + register IO * const io = GvIOn(gv); if (!io) goto nope; @@ -3943,9 +3685,9 @@ PP(pp_readdir) SV *sv; const I32 gimme = GIMME; - GV *gv = (GV *)POPs; - register Direntry_t *dp; - register IO *io = GvIOn(gv); + GV * const gv = (GV *)POPs; + register const Direntry_t *dp; + register IO * const io = GvIOn(gv); if (!io || !IoDIRP(io)) goto nope; @@ -3993,8 +3735,8 @@ PP(pp_telldir) # if !defined(HAS_TELLDIR_PROTO) || defined(NEED_TELLDIR_PROTO) long telldir (DIR *); # endif - GV *gv = (GV*)POPs; - register IO *io = GvIOn(gv); + GV * const gv = (GV*)POPs; + register IO * const io = GvIOn(gv); if (!io || !IoDIRP(io)) goto nope; @@ -4014,9 +3756,9 @@ PP(pp_seekdir) { #if defined(HAS_SEEKDIR) || defined(seekdir) dSP; - long along = POPl; - GV *gv = (GV*)POPs; - register IO *io = GvIOn(gv); + const long along = POPl; + GV * const gv = (GV*)POPs; + register IO * const io = GvIOn(gv); if (!io || !IoDIRP(io)) goto nope; @@ -4037,8 +3779,8 @@ PP(pp_rewinddir) { #if defined(HAS_REWINDDIR) || defined(rewinddir) dSP; - GV *gv = (GV*)POPs; - register IO *io = GvIOn(gv); + GV * const gv = (GV*)POPs; + register IO * const io = GvIOn(gv); if (!io || !IoDIRP(io)) goto nope; @@ -4058,8 +3800,8 @@ PP(pp_closedir) { #if defined(Direntry_t) && defined(HAS_READDIR) dSP; - GV *gv = (GV*)POPs; - register IO *io = GvIOn(gv); + GV * const gv = (GV*)POPs; + register IO * const io = GvIOn(gv); if (!io || !IoDIRP(io)) goto nope; @@ -4091,7 +3833,6 @@ PP(pp_fork) #ifdef HAS_FORK dSP; dTARGET; Pid_t childpid; - GV *tmpgv; EXTEND(SP, 1); PERL_FLUSHALL_FOR_CHILD; @@ -4099,7 +3840,8 @@ PP(pp_fork) if (childpid < 0) RETSETUNDEF; if (!childpid) { - if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV))) { + GV * const tmpgv = gv_fetchpv("$", TRUE, SVt_PV); + if (tmpgv) { SvREADONLY_off(GvSV(tmpgv)); sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid()); SvREADONLY_on(GvSV(tmpgv)); @@ -4163,13 +3905,11 @@ PP(pp_waitpid) { #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) dSP; dTARGET; - Pid_t pid; + const int optype = POPi; + const Pid_t pid = TOPi; Pid_t result; - int optype; int argflags; - optype = POPi; - pid = TOPi; if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) result = wait4pid(pid, &argflags, optype); else { @@ -4220,7 +3960,7 @@ PP(pp_system) if (errno != EAGAIN) { value = -1; SP = ORIGMARK; - PUSHi(value); + XPUSHi(value); if (did_pipes) { PerlLIO_close(pp[0]); PerlLIO_close(pp[1]); @@ -4269,7 +4009,7 @@ PP(pp_system) STATUS_NATIVE_CHILD_SET(-1); } } - PUSHi(STATUS_CURRENT); + XPUSHi(STATUS_CURRENT); RETURN; } if (did_pipes) { @@ -4279,7 +4019,7 @@ PP(pp_system) #endif } if (PL_op->op_flags & OPf_STACKED) { - SV *really = *++MARK; + SV * const really = *++MARK; value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes); } else if (SP - MARK != 1) @@ -4293,7 +4033,7 @@ PP(pp_system) PL_statusvalue = 0; result = 0; if (PL_op->op_flags & OPf_STACKED) { - SV *really = *++MARK; + SV * const really = *++MARK; # if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) value = (I32)do_aspawn(really, MARK, SP); # else @@ -4315,7 +4055,7 @@ PP(pp_system) STATUS_NATIVE_CHILD_SET(value); do_execfree(); SP = ORIGMARK; - PUSHi(result ? value : STATUS_CURRENT); + XPUSHi(result ? value : STATUS_CURRENT); #endif /* !FORK or VMS */ RETURN; } @@ -4337,7 +4077,7 @@ PP(pp_exec) } PERL_FLUSHALL_FOR_CHILD; if (PL_op->op_flags & OPf_STACKED) { - SV *really = *++MARK; + SV * const really = *++MARK; value = (I32)do_aexec(really, MARK, SP); } else if (SP - MARK != 1) @@ -4367,24 +4107,10 @@ PP(pp_exec) } SP = ORIGMARK; - PUSHi(value); + XPUSHi(value); RETURN; } -PP(pp_kill) -{ -#ifdef HAS_KILL - dSP; dMARK; dTARGET; - I32 value; - value = (I32)apply(PL_op->op_type, MARK, SP); - SP = MARK; - PUSHi(value); - RETURN; -#else - DIE(aTHX_ PL_no_func, "kill"); -#endif -} - PP(pp_getppid) { #ifdef HAS_GETPPID @@ -4407,13 +4133,9 @@ PP(pp_getpgrp) { #ifdef HAS_GETPGRP dSP; dTARGET; - Pid_t pid; Pid_t pgrp; + const Pid_t pid = (MAXARG < 1) ? 0 : SvIVx(POPs); - if (MAXARG < 1) - pid = 0; - else - pid = SvIVx(POPs); #ifdef BSD_GETPGRP pgrp = (I32)BSD_GETPGRP(pid); #else @@ -4464,8 +4186,8 @@ PP(pp_getpriority) { #ifdef HAS_GETPRIORITY dSP; dTARGET; - int who = POPi; - int which = TOPi; + const int who = POPi; + const int which = TOPi; SETi( getpriority(which, who) ); RETURN; #else @@ -4477,9 +4199,9 @@ PP(pp_setpriority) { #ifdef HAS_SETPRIORITY dSP; dTARGET; - int niceval = POPi; - int who = POPi; - int which = TOPi; + const int niceval = POPi; + const int who = POPi; + const int which = TOPi; TAINT_PROPER("setpriority"); SETi( setpriority(which, who, niceval) >= 0 ); RETURN; @@ -4538,11 +4260,6 @@ PP(pp_tms) #endif /* HAS_TIMES */ } -PP(pp_localtime) -{ - return pp_gmtime(); -} - #ifdef LOCALTIME_EDGECASE_BROKEN static struct tm *S_my_localtime (pTHX_ Time_t *tp) { @@ -4681,65 +4398,30 @@ PP(pp_sleep) } /* Shared memory. */ - -PP(pp_shmget) -{ - return pp_semget(); -} - -PP(pp_shmctl) -{ - return pp_semctl(); -} - -PP(pp_shmread) -{ - return pp_shmwrite(); -} +/* Merged with some message passing. */ PP(pp_shmwrite) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) dSP; dMARK; dTARGET; - I32 value = (I32)(do_shmio(PL_op->op_type, MARK, SP) >= 0); - SP = MARK; - PUSHi(value); - RETURN; -#else - return pp_semget(); -#endif -} - -/* Message passing. */ - -PP(pp_msgget) -{ - return pp_semget(); -} - -PP(pp_msgctl) -{ - return pp_semctl(); -} + const int op_type = PL_op->op_type; + I32 value; -PP(pp_msgsnd) -{ -#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - dSP; dMARK; dTARGET; - I32 value = (I32)(do_msgsnd(MARK, SP) >= 0); - SP = MARK; - PUSHi(value); - RETURN; -#else - return pp_semget(); -#endif -} + switch (op_type) { + case OP_MSGSND: + value = (I32)(do_msgsnd(MARK, SP) >= 0); + break; + case OP_MSGRCV: + value = (I32)(do_msgrcv(MARK, SP) >= 0); + break; + case OP_SEMOP: + value = (I32)(do_semop(MARK, SP) >= 0); + break; + default: + value = (I32)(do_shmio(op_type, MARK, SP) >= 0); + break; + } -PP(pp_msgrcv) -{ -#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - dSP; dMARK; dTARGET; - I32 value = (I32)(do_msgrcv(MARK, SP) >= 0); SP = MARK; PUSHi(value); RETURN; @@ -4754,7 +4436,7 @@ PP(pp_semget) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) dSP; dMARK; dTARGET; - int anum = do_ipcget(PL_op->op_type, MARK, SP); + const int anum = do_ipcget(PL_op->op_type, MARK, SP); SP = MARK; if (anum == -1) RETPUSHUNDEF; @@ -4769,7 +4451,7 @@ PP(pp_semctl) { #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) dSP; dMARK; dTARGET; - int anum = do_ipcctl(PL_op->op_type, MARK, SP); + const int anum = do_ipcctl(PL_op->op_type, MARK, SP); SP = MARK; if (anum == -1) RETSETUNDEF; @@ -4785,31 +4467,8 @@ PP(pp_semctl) #endif } -PP(pp_semop) -{ -#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - dSP; dMARK; dTARGET; - I32 value = (I32)(do_semop(MARK, SP) >= 0); - SP = MARK; - PUSHi(value); - RETURN; -#else - return pp_semget(); -#endif -} - /* Get system info. */ -PP(pp_ghbyname) -{ - return pp_ghostent(); -} - -PP(pp_ghbyaddr) -{ - return pp_ghostent(); -} - PP(pp_ghostent) { #if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT) @@ -4828,7 +4487,7 @@ PP(pp_ghostent) EXTEND(SP, 10); if (which == OP_GHBYNAME) { #ifdef HAS_GETHOSTBYNAME - char* name = POPpbytex; + const char* const name = POPpbytex; hent = PerlSock_gethostbyname(name); #else DIE(aTHX_ PL_no_sock_func, "gethostbyname"); @@ -4836,8 +4495,8 @@ PP(pp_ghostent) } else if (which == OP_GHBYADDR) { #ifdef HAS_GETHOSTBYADDR - int addrtype = POPi; - SV *addrsv = POPs; + const int addrtype = POPi; + SV * const addrsv = POPs; STRLEN addrlen; Netdb_host_t addr = (Netdb_host_t) SvPVbyte(addrsv, addrlen); @@ -4908,16 +4567,6 @@ PP(pp_ghostent) #endif } -PP(pp_gnbyname) -{ - return pp_gnetent(); -} - -PP(pp_gnbyaddr) -{ - return pp_gnetent(); -} - PP(pp_gnetent) { #if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT) @@ -4934,7 +4583,7 @@ PP(pp_gnetent) if (which == OP_GNBYNAME){ #ifdef HAS_GETNETBYNAME - char *name = POPpbytex; + const char * const name = POPpbytex; nent = PerlSock_getnetbyname(name); #else DIE(aTHX_ PL_no_sock_func, "getnetbyname"); @@ -4942,8 +4591,8 @@ PP(pp_gnetent) } else if (which == OP_GNBYADDR) { #ifdef HAS_GETNETBYADDR - int addrtype = POPi; - Netdb_net_t addr = (Netdb_net_t) (U32)POPu; + const int addrtype = POPi; + const Netdb_net_t addr = (Netdb_net_t) (U32)POPu; nent = PerlSock_getnetbyaddr(addr, addrtype); #else DIE(aTHX_ PL_no_sock_func, "getnetbyaddr"); @@ -5000,16 +4649,6 @@ PP(pp_gnetent) #endif } -PP(pp_gpbyname) -{ - return pp_gprotoent(); -} - -PP(pp_gpbynumber) -{ - return pp_gprotoent(); -} - PP(pp_gprotoent) { #if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT) @@ -5026,7 +4665,7 @@ PP(pp_gprotoent) if (which == OP_GPBYNAME) { #ifdef HAS_GETPROTOBYNAME - char* name = POPpbytex; + const char* const name = POPpbytex; pent = PerlSock_getprotobyname(name); #else DIE(aTHX_ PL_no_sock_func, "getprotobyname"); @@ -5034,7 +4673,7 @@ PP(pp_gprotoent) } else if (which == OP_GPBYNUMBER) { #ifdef HAS_GETPROTOBYNUMBER - int number = POPi; + const int number = POPi; pent = PerlSock_getprotobynumber(number); #else DIE(aTHX_ PL_no_sock_func, "getprotobynumber"); @@ -5078,16 +4717,6 @@ PP(pp_gprotoent) #endif } -PP(pp_gsbyname) -{ - return pp_gservent(); -} - -PP(pp_gsbyport) -{ - return pp_gservent(); -} - PP(pp_gservent) { #if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT) @@ -5104,29 +4733,21 @@ PP(pp_gservent) if (which == OP_GSBYNAME) { #ifdef HAS_GETSERVBYNAME - char *proto = POPpbytex; - char *name = POPpbytex; - - if (proto && !*proto) - proto = Nullch; - - sent = PerlSock_getservbyname(name, proto); + const char * const proto = POPpbytex; + const char * const name = POPpbytex; + sent = PerlSock_getservbyname(name, (proto && !*proto) ? Nullch : proto); #else DIE(aTHX_ PL_no_sock_func, "getservbyname"); #endif } else if (which == OP_GSBYPORT) { #ifdef HAS_GETSERVBYPORT - char *proto = POPpbytex; + const char * const proto = POPpbytex; unsigned short port = (unsigned short)POPu; - - if (proto && !*proto) - proto = Nullch; - #ifdef HAS_HTONS port = PerlSock_htons(port); #endif - sent = PerlSock_getservbyport(port, proto); + sent = PerlSock_getservbyport(port, (proto && !*proto) ? Nullch : proto); #else DIE(aTHX_ PL_no_sock_func, "getservbyport"); #endif @@ -5272,16 +4893,6 @@ PP(pp_eservent) #endif } -PP(pp_gpwnam) -{ - return pp_gpwent(); -} - -PP(pp_gpwuid) -{ - return pp_gpwent(); -} - PP(pp_gpwent) { #ifdef HAS_PASSWD @@ -5358,7 +4969,7 @@ PP(pp_gpwent) switch (which) { case OP_GPWNAM: { - char* name = POPpbytex; + const char* const name = POPpbytex; pwent = getpwnam(name); } break; @@ -5422,14 +5033,12 @@ PP(pp_gpwent) * has a different API than the Solaris/IRIX one. */ # if defined(HAS_GETSPNAM) && !defined(_AIX) { - struct spwd *spwent; - int saverrno; /* Save and restore errno so that + const int saverrno = errno; + const struct spwd * const spwent = getspnam(pwent->pw_name); + /* Save and restore errno so that * underprivileged attempts seem * to have never made the unsccessful * attempt to retrieve the shadow password. */ - - saverrno = errno; - spwent = getspnam(pwent->pw_name); errno = saverrno; if (spwent && spwent->sp_pwdp) sv_setpv(sv, spwent->sp_pwdp); @@ -5540,16 +5149,6 @@ PP(pp_epwent) #endif } -PP(pp_ggrnam) -{ - return pp_ggrent(); -} - -PP(pp_ggrgid) -{ - return pp_ggrent(); -} - PP(pp_ggrent) { #ifdef HAS_GROUP @@ -5560,11 +5159,11 @@ PP(pp_ggrent) struct group *grent; if (which == OP_GGRNAM) { - char* name = POPpbytex; + const char* const name = POPpbytex; grent = (struct group *)getgrnam(name); } else if (which == OP_GGRGID) { - Gid_t gid = POPi; + const Gid_t gid = POPi; grent = (struct group *)getgrgid(gid); } else @@ -5824,11 +5423,10 @@ static int lockf_emulate_flock(int fd, int operation) { int i; - int save_errno; + const int save_errno = errno; Off_t pos; /* flock locks entire file so for lockf we need to do the same */ - save_errno = errno; pos = PerlLIO_lseek(fd, (Off_t)0, SEEK_CUR); /* get pos to restore later */ if (pos > 0) /* is seekable and needs to be repositioned */ if (PerlLIO_lseek(fd, (Off_t)0, SEEK_SET) < 0)