X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/086d291379a28ceb3cd7cc6416747be8c426476b..2ec5653d4ccd411ce2acd12770f34b981c5dc303:/pp_sys.c diff --git a/pp_sys.c b/pp_sys.c index a6d356e..30a2645 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -358,7 +358,22 @@ PP(pp_glob) { dVAR; OP *result; - tryAMAGICunTARGET(iter, -1); + dSP; + /* make a copy of the pattern, to ensure that magic is called once + * and only once */ + TOPm1s = sv_2mortal(newSVsv(TOPm1s)); + + tryAMAGICunTARGET(iter_amg, -1, (PL_op->op_flags & OPf_SPECIAL)); + + if (PL_op->op_flags & OPf_SPECIAL) { + /* call Perl-level glob function instead. Stack args are: + * MARK, wildcard, csh_glob context index + * and following OPs should be: gv(CORE::GLOBAL::glob), entersub + * */ + return NORMAL; + } + /* stack args are: wildcard, gv(_GEN_n) */ + /* Note that we only ever get here if File::Glob fails to load * without at the same time croaking, for some reason, or if @@ -434,7 +449,9 @@ PP(pp_warn) else { exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP); } - warn_sv(exsv); + if (SvROK(exsv) && !PL_warnhook) + Perl_warn(aTHX_ "%"SVf, SVfARG(exsv)); + else warn_sv(exsv); RETSETYES; } @@ -487,12 +504,60 @@ PP(pp_die) else { exsv = newSVpvs_flags("Died", SVs_TEMP); } - die_sv(exsv); - RETURN; + return die_sv(exsv); } /* I/O. */ +OP * +Perl_tied_method(pTHX_ const char *const methname, SV **sp, SV *const sv, + const MAGIC *const mg, const U32 flags, U32 argc, ...) +{ + PERL_ARGS_ASSERT_TIED_METHOD; + + /* Ensure that our flag bits do not overlap. */ + assert((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0); + assert((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0); + assert((TIED_METHOD_SAY & G_WANT) == 0); + + PUSHMARK(sp); + PUSHs(SvTIED_obj(sv, mg)); + if (flags & TIED_METHOD_ARGUMENTS_ON_STACK) + sp += argc; + else if (argc) { + const U32 mortalize_not_needed + = flags & TIED_METHOD_MORTALIZE_NOT_NEEDED; + va_list args; + va_start(args, argc); + do { + SV *const arg = va_arg(args, SV *); + if(mortalize_not_needed) + PUSHs(arg); + else + mPUSHs(arg); + } while (--argc); + va_end(args); + } + + PUTBACK; + ENTER_with_name("call_tied_method"); + if (flags & TIED_METHOD_SAY) { + /* local $\ = "\n" */ + SAVEGENERICSV(PL_ors_sv); + PL_ors_sv = newSVpvs("\n"); + } + call_method(methname, flags & G_WANT); + LEAVE_with_name("call_tied_method"); + return NORMAL; +} + +#define tied_method0(a,b,c,d) \ + Perl_tied_method(aTHX_ a,b,c,d,G_SCALAR,0) +#define tied_method1(a,b,c,d,e) \ + Perl_tied_method(aTHX_ a,b,c,d,G_SCALAR,1,e) +#define tied_method2(a,b,c,d,e,f) \ + Perl_tied_method(aTHX_ a,b,c,d,G_SCALAR,2,e,f) + PP(pp_open) { dVAR; dSP; @@ -506,11 +571,11 @@ PP(pp_open) GV * const gv = MUTABLE_GV(*++MARK); - if (!isGV(gv)) + if (!isGV(gv) && !(SvTYPE(gv) == SVt_PVLV && isGV_with_GP(gv))) DIE(aTHX_ PL_no_usym, "filehandle"); if ((io = GvIOp(gv))) { - MAGIC *mg; + const MAGIC *mg; IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; if (IoDIRP(io)) @@ -522,14 +587,9 @@ PP(pp_open) if (mg) { /* Method's args are same as ours ... */ /* ... except handle is replaced by the object */ - *MARK-- = SvTIED_obj(MUTABLE_SV(io), mg); - PUSHMARK(MARK); - PUTBACK; - ENTER_with_name("call_OPEN"); - call_method("OPEN", G_SCALAR); - LEAVE_with_name("call_OPEN"); - SPAGAIN; - RETURN; + return Perl_tied_method(aTHX_ "OPEN", mark - 1, MUTABLE_SV(io), mg, + G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, + sp - mark); } } @@ -552,54 +612,6 @@ PP(pp_open) RETURN; } -/* These are private to this function, which is private to this file. - Use 0x04 rather than the next available bit, to help the compiler if the - architecture can generate more efficient instructions. */ -#define MORTALIZE_NOT_NEEDED 0x04 -#define TIED_HANDLE_ARGC_SHIFT 3 - -static OP * -S_tied_handle_method(pTHX_ const char *const methname, SV **sp, - IO *const io, MAGIC *const mg, const U32 flags, ...) -{ - U32 argc = flags >> TIED_HANDLE_ARGC_SHIFT; - - PERL_ARGS_ASSERT_TIED_HANDLE_METHOD; - - /* Ensure that our flag bits do not overlap. */ - assert((MORTALIZE_NOT_NEEDED & G_WANT) == 0); - assert((G_WANT >> TIED_HANDLE_ARGC_SHIFT) == 0); - - PUSHMARK(sp); - PUSHs(SvTIED_obj(MUTABLE_SV(io), mg)); - if (argc) { - const U32 mortalize_not_needed = flags & MORTALIZE_NOT_NEEDED; - va_list args; - va_start(args, flags); - do { - SV *const arg = va_arg(args, SV *); - if(mortalize_not_needed) - PUSHs(arg); - else - mPUSHs(arg); - } while (--argc); - va_end(args); - } - - PUTBACK; - ENTER_with_name("call_tied_handle_method"); - call_method(methname, flags & G_WANT); - LEAVE_with_name("call_tied_handle_method"); - return NORMAL; -} - -#define tied_handle_method(a,b,c,d) \ - S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR) -#define tied_handle_method1(a,b,c,d,e) \ - S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (1 << TIED_HANDLE_ARGC_SHIFT),e) -#define tied_handle_method2(a,b,c,d,e,f) \ - S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (2 << TIED_HANDLE_ARGC_SHIFT), e,f) - PP(pp_close) { dVAR; dSP; @@ -611,9 +623,9 @@ PP(pp_close) if (gv) { IO * const io = GvIO(gv); if (io) { - MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { - return tied_handle_method("CLOSE", SP, io, mg); + return tied_method0("CLOSE", SP, MUTABLE_SV(io), mg); } } } @@ -677,7 +689,6 @@ badexit: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_func, "pipe"); - return NORMAL; #endif } @@ -687,23 +698,24 @@ PP(pp_fileno) GV *gv; IO *io; PerlIO *fp; - MAGIC *mg; + const MAGIC *mg; if (MAXARG < 1) RETPUSHUNDEF; gv = MUTABLE_GV(POPs); + io = GvIO(gv); - if (gv && (io = GvIO(gv)) + if (io && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) { - return tied_handle_method("FILENO", SP, io, mg); + return tied_method0("FILENO", SP, MUTABLE_SV(io), mg); } - if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) { + if (!io || !(fp = IoIFP(io))) { /* Can't do this because people seem to do things like defined(fileno($foo)) to check whether $foo is a valid fh. - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + + report_evil_fh(gv); */ RETPUSHUNDEF; } @@ -758,25 +770,23 @@ PP(pp_binmode) } gv = MUTABLE_GV(POPs); + io = GvIO(gv); - if (gv && (io = GvIO(gv))) { - MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (io) { + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { /* This takes advantage of the implementation of the varargs function, which I don't think that the optimiser will be able to figure out. Although, as it's a static function, in theory it could. */ - return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg, - G_SCALAR|MORTALIZE_NOT_NEEDED - | (discp - ? (1 << TIED_HANDLE_ARGC_SHIFT) : 0), - discp); + return Perl_tied_method(aTHX_ "BINMODE", SP, MUTABLE_SV(io), mg, + G_SCALAR|TIED_METHOD_MORTALIZE_NOT_NEEDED, + discp ? 1 : 0, discp); } } - if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + if (!io || !(fp = IoIFP(io))) { + report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; } @@ -827,7 +837,12 @@ PP(pp_tie) methname = "TIEARRAY"; break; case SVt_PVGV: + case SVt_PVLV: if (isGV_with_GP(varsv)) { + if (SvFAKE(varsv) && !(GvFLAGS(varsv) & GVf_TIEWARNED)) { + deprecate("tie on a handle without *"); + GvFLAGS(varsv) |= GVf_TIEWARNED; + } methname = "TIEHANDLE"; how = PERL_MAGIC_tiedscalar; /* For tied filehandles, we apply tiedscalar magic to the IO @@ -904,8 +919,14 @@ PP(pp_untie) const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; - if (isGV_with_GP(sv) && !(sv = MUTABLE_SV(GvIOp(sv)))) + if (isGV_with_GP(sv)) { + if (SvFAKE(sv) && !(GvFLAGS(sv) & GVf_TIEWARNED)) { + deprecate("untie on a handle without *"); + GvFLAGS(sv) |= GVf_TIEWARNED; + } + if (!(sv = MUTABLE_SV(GvIOp(sv)))) RETPUSHYES; + } if ((mg = SvTIED_mg(sv, how))) { SV * const obj = SvRV(SvTIED_obj(sv, mg)); @@ -942,8 +963,14 @@ PP(pp_tied) const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; - if (isGV_with_GP(sv) && !(sv = MUTABLE_SV(GvIOp(sv)))) + if (isGV_with_GP(sv)) { + if (SvFAKE(sv) && !(GvFLAGS(sv) & GVf_TIEWARNED)) { + deprecate("tied on a handle without *"); + GvFLAGS(sv) |= GVf_TIEWARNED; + } + if (!(sv = MUTABLE_SV(GvIOp(sv)))) RETPUSHUNDEF; + } if ((mg = SvTIED_mg(sv, how))) { SV *osv = SvTIED_obj(sv, mg); @@ -1045,7 +1072,7 @@ PP(pp_sselect) if (SvIsCOW(sv)) sv_force_normal_flags(sv, 0); if (SvREADONLY(sv) && !(SvPOK(sv) && SvCUR(sv) == 0)) - DIE(aTHX_ "%s", PL_no_modify); + Perl_croak_no_modify(aTHX); } if (!SvPOK(sv)) { Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask"); @@ -1168,7 +1195,6 @@ PP(pp_sselect) RETURN; #else DIE(aTHX_ "select not implemented"); - return NORMAL; #endif } @@ -1227,17 +1253,17 @@ PP(pp_select) PP(pp_getc) { dVAR; dSP; dTARGET; - IO *io = NULL; GV * const gv = (MAXARG==0) ? PL_stdingv : MUTABLE_GV(POPs); + IO *const io = GvIO(gv); if (MAXARG == 0) EXTEND(SP, 1); - if (gv && (io = GvIO(gv))) { - MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (io) { + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { const U32 gimme = GIMME_V; - S_tied_handle_method(aTHX_ "GETC", SP, io, mg, gimme); + Perl_tied_method(aTHX_ "GETC", SP, MUTABLE_SV(io), mg, gimme, 0); if (gimme == G_SCALAR) { SPAGAIN; SvSetMagicSV_nosteal(TARG, TOPs); @@ -1246,9 +1272,8 @@ PP(pp_getc) } } if (!gv || do_eof(gv)) { /* make sure we have fp with something */ - if ((!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY)) - && ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + if (!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY)) + report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; } @@ -1278,6 +1303,9 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop) PERL_ARGS_ASSERT_DOFORM; + if (cv && CvCLONE(cv)) + cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv)))); + ENTER; SAVETMPS; @@ -1333,9 +1361,6 @@ PP(pp_enterwrite) not_a_format_reference: DIE(aTHX_ "Not a format reference"); } - if (CvCLONE(cv)) - cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv)))); - IoFLAGS(io) &= ~IOf_DIDTOP; return doform(cv,gv,PL_op->op_next); } @@ -1350,6 +1375,7 @@ PP(pp_leavewrite) SV **newsp; I32 gimme; register PERL_CONTEXT *cx; + OP *retop; if (!io || !(ofp = IoOFP(io))) goto forget_top; @@ -1424,24 +1450,21 @@ PP(pp_leavewrite) else DIE(aTHX_ "Undefined top format called"); } - if (cv && CvCLONE(cv)) - cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv)))); return doform(cv, gv, PL_op); } forget_top: POPBLOCK(cx,PL_curpm); POPFORMAT(cx); + retop = cx->blk_sub.retop; LEAVE; fp = IoOFP(io); if (!fp) { - if (ckWARN2(WARN_CLOSED,WARN_IO)) { - if (IoIFP(io)) - report_evil_fh(gv, io, OP_phoney_INPUT_ONLY); - else if (ckWARN(WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); - } + if (IoIFP(io)) + report_wrongway_fh(gv, '<'); + else + report_evil_fh(gv); PUSHs(&PL_sv_no); } else { @@ -1464,21 +1487,21 @@ PP(pp_leavewrite) PUTBACK; PERL_UNUSED_VAR(newsp); PERL_UNUSED_VAR(gimme); - return cx->blk_sub.retop; + return retop; } PP(pp_prtf) { dVAR; dSP; dMARK; dORIGMARK; - IO *io; PerlIO *fp; SV *sv; GV * const gv = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv; + IO *const io = GvIO(gv); - if (gv && (io = GvIO(gv))) { - MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (io) { + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { if (MARK == ORIGMARK) { MEXTEND(SP, 1); @@ -1486,34 +1509,24 @@ PP(pp_prtf) Move(MARK, MARK + 1, (SP - MARK) + 1, SV*); ++SP; } - PUSHMARK(MARK - 1); - *MARK = SvTIED_obj(MUTABLE_SV(io), mg); - PUTBACK; - ENTER; - call_method("PRINTF", G_SCALAR); - LEAVE; - SPAGAIN; - MARK = ORIGMARK + 1; - *MARK = *SP; - SP = MARK; - RETURN; + return Perl_tied_method(aTHX_ "PRINTF", mark - 1, MUTABLE_SV(io), + mg, + G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, + sp - mark); } } sv = newSV(0); - if (!(io = GvIO(gv))) { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + if (!io) { + report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); goto just_say_no; } else if (!(fp = IoOFP(io))) { - if (ckWARN2(WARN_CLOSED,WARN_IO)) { - if (IoIFP(io)) - report_evil_fh(gv, io, OP_phoney_INPUT_ONLY); - else if (ckWARN(WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); - } + if (IoIFP(io)) + report_wrongway_fh(gv, '<'); + else if (ckWARN(WARN_CLOSED)) + report_evil_fh(gv); SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI); goto just_say_no; } @@ -1587,19 +1600,11 @@ PP(pp_sysread) if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) && gv && (io = GvIO(gv)) ) { - const MAGIC * mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { - SV *sv; - PUSHMARK(MARK-1); - *MARK = SvTIED_obj(MUTABLE_SV(io), mg); - ENTER; - call_method("READ", G_SCALAR); - LEAVE; - SPAGAIN; - sv = POPs; - SP = ORIGMARK; - PUSHs(sv); - RETURN; + return Perl_tied_method(aTHX_ "READ", mark - 1, MUTABLE_SV(io), mg, + G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, + sp - mark); } } @@ -1616,8 +1621,7 @@ PP(pp_sysread) offset = 0; io = GvIO(gv); if (!io || !IoIFP(io)) { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); goto say_undef; } @@ -1657,6 +1661,9 @@ PP(pp_sysread) (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; + /* MSG_TRUNC can give oversized count; quietly lose it */ + if (count > length) + count = length; #ifdef EPOC /* Bogus return without padding */ bufsize = sizeof (struct sockaddr_in); @@ -1675,9 +1682,6 @@ PP(pp_sysread) PUSHs(TARG); RETURN; } -#else - if (PL_op->op_type == OP_RECV) - DIE(aTHX_ PL_no_sock_func, "recv"); #endif if (DO_UTF8(bufsv)) { /* offset adjust in characters not bytes */ @@ -1756,8 +1760,8 @@ PP(pp_sysread) count = -1; } if (count < 0) { - if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO)) - report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY); + if (IoTYPE(io) == IoTYPE_WRONLY) + report_wrongway_fh(gv, '>'); goto say_undef; } SvCUR_set(read_target, count+(buffer - SvPVX_const(read_target))); @@ -1816,10 +1820,9 @@ PP(pp_sysread) RETPUSHUNDEF; } -PP(pp_send) +PP(pp_syswrite) { dVAR; dSP; dMARK; dORIGMARK; dTARGET; - IO *io; SV *bufsv; const char *buffer; SSize_t retval; @@ -1828,30 +1831,21 @@ PP(pp_send) const int op_type = PL_op->op_type; bool doing_utf8; U8 *tmpbuf = NULL; - GV *const gv = MUTABLE_GV(*++MARK); - if (PL_op->op_type == OP_SYSWRITE - && gv && (io = GvIO(gv))) { - MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { - SV *sv; + IO *const io = GvIO(gv); + if (op_type == OP_SYSWRITE && io) { + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { if (MARK == SP - 1) { - sv = *SP; + SV *sv = *SP; mXPUSHi(sv_len(sv)); PUTBACK; } - PUSHMARK(ORIGMARK); - *(ORIGMARK+1) = SvTIED_obj(MUTABLE_SV(io), mg); - ENTER; - call_method("WRITE", G_SCALAR); - LEAVE; - SPAGAIN; - sv = POPs; - SP = ORIGMARK; - PUSHs(sv); - RETURN; + return Perl_tied_method(aTHX_ "WRITE", mark - 1, MUTABLE_SV(io), mg, + G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, + sp - mark); } } if (!gv) @@ -1860,15 +1854,12 @@ PP(pp_send) bufsv = *++MARK; SETERRNO(0,0); - io = GvIO(gv); if (!io || !IoIFP(io) || IoTYPE(io) == IoTYPE_RDONLY) { retval = -1; - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) { - if (io && IoIFP(io)) - report_evil_fh(gv, io, OP_phoney_INPUT_ONLY); - else - report_evil_fh(gv, io, PL_op->op_type); - } + if (io && IoIFP(io)) + report_wrongway_fh(gv, '<'); + else + report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); goto say_undef; } @@ -1900,7 +1891,23 @@ PP(pp_send) } } - if (op_type == OP_SYSWRITE) { +#ifdef HAS_SOCKET + if (op_type == OP_SEND) { + 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 +#endif + { Size_t length = 0; /* This length is in characters. */ STRLEN blen_chars; IV offset; @@ -1995,24 +2002,6 @@ PP(pp_send) buffer, length); } } -#ifdef HAS_SOCKET - 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 - else - DIE(aTHX_ PL_no_sock_func, "send"); -#endif if (retval < 0) goto say_undef; @@ -2039,7 +2028,7 @@ PP(pp_eof) dVAR; dSP; GV *gv; IO *io; - MAGIC *mg; + const MAGIC *mg; /* * in Perl 5.12 and later, the additional parameter is a bitmask: * 0 = eof @@ -2073,7 +2062,7 @@ PP(pp_eof) RETPUSHNO; if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) { - return tied_handle_method1("EOF", SP, io, mg, newSVuv(which)); + return tied_method1("EOF", SP, MUTABLE_SV(io), mg, newSVuv(which)); } if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) { /* eof() */ @@ -2109,10 +2098,11 @@ PP(pp_tell) EXTEND(SP, 1); gv = PL_last_in_gv; - if (gv && (io = GvIO(gv))) { - MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + io = GvIO(gv); + if (io) { + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { - return tied_handle_method("TELL", SP, io, mg); + return tied_method0("TELL", SP, MUTABLE_SV(io), mg); } } else if (!gv) { @@ -2141,10 +2131,10 @@ PP(pp_sysseek) #endif GV * const gv = PL_last_in_gv = MUTABLE_GV(POPs); - IO *io; + IO *const io = GvIO(gv); - if (gv && (io = GvIO(gv))) { - MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (io) { + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { #if LSEEKSIZE > IVSIZE SV *const offset_sv = newSVnv((NV) offset); @@ -2152,8 +2142,8 @@ PP(pp_sysseek) SV *const offset_sv = newSViv(offset); #endif - return tied_handle_method2("SEEK", SP, io, mg, offset_sv, - newSViv(whence)); + return tied_method2("SEEK", SP, MUTABLE_SV(io), mg, offset_sv, + newSViv(whence)); } } @@ -2206,11 +2196,11 @@ PP(pp_truncate) tmpgv = gv_fetchsv(POPs, 0, SVt_PVIO); do_ftruncate_gv: - if (!GvIO(tmpgv)) + io = GvIO(tmpgv); + if (!io) result = 0; else { PerlIO *fp; - io = GvIOp(tmpgv); do_ftruncate_io: TAINT_PROPER("truncate"); if (!(fp = IoIFP(io))) { @@ -2284,8 +2274,7 @@ PP(pp_ioctl) IV retval; if (!io || !argsv || !IoIFP(io)) { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); /* well, sort of... */ RETPUSHUNDEF; } @@ -2352,25 +2341,18 @@ PP(pp_flock) #ifdef FLOCK dVAR; dSP; dTARGET; I32 value; - IO *io = NULL; - PerlIO *fp; const int argtype = POPi; GV * const gv = (MAXARG == 0) ? PL_last_in_gv : MUTABLE_GV(POPs); + IO *const io = GvIO(gv); + PerlIO *const fp = io ? IoIFP(io) : NULL; - if (gv && (io = GvIO(gv))) - fp = IoIFP(io); - else { - fp = NULL; - 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); } else { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); value = 0; SETERRNO(EBADF,RMS_IFI); } @@ -2378,15 +2360,15 @@ PP(pp_flock) RETURN; #else DIE(aTHX_ PL_no_func, "flock()"); - return NORMAL; #endif } /* Sockets. */ +#ifdef HAS_SOCKET + PP(pp_socket) { -#ifdef HAS_SOCKET dVAR; dSP; const int protocol = POPi; const int type = POPi; @@ -2395,9 +2377,8 @@ PP(pp_socket) register IO * const io = gv ? GvIOn(gv) : NULL; int fd; - if (!gv || !io) { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + if (!io) { + report_evil_fh(gv); if (io && IoIFP(io)) do_close(gv, FALSE); SETERRNO(EBADF,LIB_INVARG); @@ -2429,11 +2410,8 @@ PP(pp_socket) #endif RETPUSHYES; -#else - DIE(aTHX_ PL_no_sock_func, "socket"); - return NORMAL; -#endif } +#endif PP(pp_sockpair) { @@ -2448,25 +2426,19 @@ PP(pp_sockpair) register IO * const io2 = gv2 ? GvIOn(gv2) : NULL; int fd[2]; - if (!gv1 || !gv2 || !io1 || !io2) { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) { - if (!gv1 || !io1) - report_evil_fh(gv1, io1, PL_op->op_type); - if (!gv2 || !io2) - report_evil_fh(gv1, io2, PL_op->op_type); - } - if (io1 && IoIFP(io1)) - do_close(gv1, FALSE); - if (io2 && IoIFP(io2)) - do_close(gv2, FALSE); - RETPUSHUNDEF; - } + if (!io1) + report_evil_fh(gv1); + if (!io2) + report_evil_fh(gv2); - if (IoIFP(io1)) + if (io1 && IoIFP(io1)) do_close(gv1, FALSE); - if (IoIFP(io2)) + if (io2 && IoIFP(io2)) do_close(gv2, FALSE); + if (!io1 || !io2) + RETPUSHUNDEF; + TAINT_PROPER("socketpair"); if (PerlSock_socketpair(domain, type, protocol, fd) < 0) RETPUSHUNDEF; @@ -2493,13 +2465,13 @@ PP(pp_sockpair) RETPUSHYES; #else DIE(aTHX_ PL_no_sock_func, "socketpair"); - return NORMAL; #endif } +#ifdef HAS_SOCKET + PP(pp_bind) { -#ifdef HAS_SOCKET dVAR; dSP; SV * const addrsv = POPs; /* OK, so on what platform does bind modify addr? */ @@ -2507,68 +2479,35 @@ PP(pp_bind) GV * const gv = MUTABLE_GV(POPs); register IO * const io = GvIOn(gv); STRLEN len; + const int op_type = PL_op->op_type; if (!io || !IoIFP(io)) goto nuts; addr = SvPV_const(addrsv, len); - TAINT_PROPER("bind"); - if (PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0) - RETPUSHYES; - else - RETPUSHUNDEF; - -nuts: - if (ckWARN(WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); - SETERRNO(EBADF,SS_IVCHAN); - RETPUSHUNDEF; -#else - DIE(aTHX_ PL_no_sock_func, "bind"); - return NORMAL; -#endif -} - -PP(pp_connect) -{ -#ifdef HAS_SOCKET - dVAR; dSP; - SV * const addrsv = POPs; - GV * const gv = MUTABLE_GV(POPs); - register IO * const io = GvIOn(gv); - const char *addr; - STRLEN len; - - if (!io || !IoIFP(io)) - goto nuts; - - addr = SvPV_const(addrsv, len); - TAINT_PROPER("connect"); - if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0) + TAINT_PROPER(PL_op_desc[op_type]); + if ((op_type == OP_BIND + ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) + : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)) + >= 0) RETPUSHYES; else RETPUSHUNDEF; nuts: - if (ckWARN(WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF,SS_IVCHAN); RETPUSHUNDEF; -#else - DIE(aTHX_ PL_no_sock_func, "connect"); - return NORMAL; -#endif } PP(pp_listen) { -#ifdef HAS_SOCKET dVAR; dSP; const int backlog = POPi; GV * const gv = MUTABLE_GV(POPs); register IO * const io = gv ? GvIOn(gv) : NULL; - if (!gv || !io || !IoIFP(io)) + if (!io || !IoIFP(io)) goto nuts; if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0) @@ -2577,19 +2516,13 @@ PP(pp_listen) RETPUSHUNDEF; nuts: - if (ckWARN(WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF,SS_IVCHAN); RETPUSHUNDEF; -#else - DIE(aTHX_ PL_no_sock_func, "listen"); - return NORMAL; -#endif } PP(pp_accept) { -#ifdef HAS_SOCKET dVAR; dSP; dTARGET; register IO *nstio; register IO *gstio; @@ -2654,22 +2587,16 @@ PP(pp_accept) RETURN; nuts: - if (ckWARN(WARN_CLOSED)) - report_evil_fh(ggv, ggv ? GvIO(ggv) : 0, PL_op->op_type); + report_evil_fh(ggv); SETERRNO(EBADF,SS_IVCHAN); badexit: RETPUSHUNDEF; -#else - DIE(aTHX_ PL_no_sock_func, "accept"); - return NORMAL; -#endif } PP(pp_shutdown) { -#ifdef HAS_SOCKET dVAR; dSP; dTARGET; const int how = POPi; GV * const gv = MUTABLE_GV(POPs); @@ -2682,19 +2609,13 @@ PP(pp_shutdown) RETURN; nuts: - if (ckWARN(WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF,SS_IVCHAN); RETPUSHUNDEF; -#else - DIE(aTHX_ PL_no_sock_func, "shutdown"); - return NORMAL; -#endif } PP(pp_ssockopt) { -#ifdef HAS_SOCKET dVAR; dSP; const int optype = PL_op->op_type; SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(newSV(257)) : POPs; @@ -2758,21 +2679,15 @@ PP(pp_ssockopt) RETURN; nuts: - if (ckWARN(WARN_CLOSED)) - report_evil_fh(gv, io, optype); + report_evil_fh(gv); SETERRNO(EBADF,SS_IVCHAN); nuts2: RETPUSHUNDEF; -#else - DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); - return NORMAL; -#endif } PP(pp_getpeername) { -#ifdef HAS_SOCKET dVAR; dSP; const int optype = PL_op->op_type; GV * const gv = MUTABLE_GV(POPs); @@ -2823,17 +2738,13 @@ PP(pp_getpeername) RETURN; nuts: - if (ckWARN(WARN_CLOSED)) - report_evil_fh(gv, io, optype); + report_evil_fh(gv); SETERRNO(EBADF,SS_IVCHAN); nuts2: RETPUSHUNDEF; +} -#else - DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); - return NORMAL; #endif -} /* Stat calls. */ @@ -2880,8 +2791,7 @@ PP(pp_stat) } if (PL_laststatval < 0) { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, GvIO(gv), PL_op->op_type); + report_evil_fh(gv); max = 0; } } @@ -3052,7 +2962,7 @@ PP(pp_ftrread) conditional compiling below much clearer. */ I32 use_access = 0; #endif - int stat_mode = S_IRUSR; + Mode_t stat_mode = S_IRUSR; bool effective = FALSE; char opchar = '?'; @@ -3146,7 +3056,7 @@ PP(pp_ftrread) #endif } - result = my_stat(); + result = my_stat_flags(0); SPAGAIN; if (result < 0) RETPUSHUNDEF; @@ -3174,7 +3084,7 @@ PP(pp_ftis) STACKED_FTEST_CHECK; - result = my_stat(); + result = my_stat_flags(0); SPAGAIN; if (result < 0) RETPUSHUNDEF; @@ -3229,24 +3139,33 @@ PP(pp_ftrowned) } tryAMAGICftest_MG(opchar); + STACKED_FTEST_CHECK; + /* 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) + if(PL_op->op_type == OP_FTSUID) { + if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0) + (void) POPs; RETPUSHNO; + } #endif #ifndef S_ISGID - if(PL_op->op_type == OP_FTSGID) + if(PL_op->op_type == OP_FTSGID) { + if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0) + (void) POPs; RETPUSHNO; + } #endif #ifndef S_ISVTX - if(PL_op->op_type == OP_FTSVTX) + if(PL_op->op_type == OP_FTSVTX) { + if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0) + (void) POPs; RETPUSHNO; + } #endif - STACKED_FTEST_CHECK; - - result = my_stat(); + result = my_stat_flags(0); SPAGAIN; if (result < 0) RETPUSHUNDEF; @@ -3316,7 +3235,7 @@ PP(pp_ftlink) I32 result; tryAMAGICftest_MG('l'); - result = my_lstat(); + result = my_lstat_flags(0); SPAGAIN; if (result < 0) @@ -3333,6 +3252,8 @@ PP(pp_fttty) int fd; GV *gv; SV *tmpsv = NULL; + char *name = NULL; + STRLEN namelen; tryAMAGICftest_MG('t'); @@ -3340,19 +3261,21 @@ PP(pp_fttty) if (PL_op->op_flags & OPf_REF) gv = cGVOP_gv; - else if (isGV(TOPs)) + else if (isGV_with_GP(TOPs)) gv = MUTABLE_GV(POPs); else if (SvROK(TOPs) && isGV(SvRV(TOPs))) gv = MUTABLE_GV(SvRV(POPs)); - else - gv = gv_fetchsv(tmpsv = POPs, 0, SVt_PVIO); + else { + tmpsv = POPs; + name = SvPV_nomg(tmpsv, namelen); + gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO); + } if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (tmpsv && SvOK(tmpsv)) { - const char *tmps = SvPV_nolen_const(tmpsv); - if (isDIGIT(*tmps)) - fd = atoi(tmps); + if (isDIGIT(*name)) + fd = atoi(name); else RETPUSHUNDEF; } @@ -3391,7 +3314,7 @@ PP(pp_fttext) if (PL_op->op_flags & OPf_REF) gv = cGVOP_gv; - else if (isGV(TOPs)) + else if (isGV_with_GP(TOPs)) gv = MUTABLE_GV(POPs); else if (SvROK(TOPs) && isGV(SvRV(TOPs))) gv = MUTABLE_GV(SvRV(POPs)); @@ -3440,10 +3363,7 @@ PP(pp_fttext) len = 512; } else { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) { - gv = cGVOP_gv; - report_evil_fh(gv, GvIO(gv), PL_op->op_type); - } + report_evil_fh(cGVOP_gv); SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; } @@ -3453,7 +3373,7 @@ PP(pp_fttext) really_filename: PL_statgv = NULL; PL_laststype = OP_STAT; - sv_setpv(PL_statname, SvPV_nolen_const(sv)); + sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) { if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), '\n')) @@ -3587,15 +3507,13 @@ PP(pp_chdir) PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0); } else { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF, RMS_IFI); PUSHi(0); } } else { - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); + report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); PUSHi(0); } @@ -3633,7 +3551,6 @@ PP(pp_chroot) RETURN; #else DIE(aTHX_ PL_no_func, "chroot"); - return NORMAL; #endif } @@ -3708,7 +3625,6 @@ PP(pp_link) { /* Have neither. */ DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); - return NORMAL; } #endif @@ -3923,7 +3839,6 @@ nope: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "opendir"); - return NORMAL; #endif } @@ -3931,7 +3846,6 @@ 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 *); @@ -4010,7 +3924,6 @@ nope: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "telldir"); - return NORMAL; #endif } @@ -4036,7 +3949,6 @@ nope: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "seekdir"); - return NORMAL; #endif } @@ -4060,7 +3972,6 @@ nope: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "rewinddir"); - return NORMAL; #endif } @@ -4093,7 +4004,6 @@ nope: RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "closedir"); - return NORMAL; #endif } @@ -4140,7 +4050,6 @@ PP(pp_fork) RETURN; # else DIE(aTHX_ PL_no_func, "fork"); - return NORMAL; # endif #endif } @@ -4170,7 +4079,6 @@ PP(pp_wait) RETURN; #else DIE(aTHX_ PL_no_func, "wait"); - return NORMAL; #endif } @@ -4201,7 +4109,6 @@ PP(pp_waitpid) RETURN; #else DIE(aTHX_ PL_no_func, "waitpid"); - return NORMAL; #endif } @@ -4407,7 +4314,6 @@ PP(pp_getppid) RETURN; #else DIE(aTHX_ PL_no_func, "getppid"); - return NORMAL; #endif } @@ -4429,7 +4335,6 @@ PP(pp_getpgrp) RETURN; #else DIE(aTHX_ PL_no_func, "getpgrp()"); - return NORMAL; #endif } @@ -4463,21 +4368,25 @@ PP(pp_setpgrp) RETURN; #else DIE(aTHX_ PL_no_func, "setpgrp()"); - return NORMAL; #endif } +#if defined(__GLIBC__) && ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 3) || (__GLIBC__ > 2)) +# define PRIORITY_WHICH_T(which) (__priority_which_t)which +#else +# define PRIORITY_WHICH_T(which) which +#endif + PP(pp_getpriority) { #ifdef HAS_GETPRIORITY dVAR; dSP; dTARGET; const int who = POPi; const int which = TOPi; - SETi( getpriority(which, who) ); + SETi( getpriority(PRIORITY_WHICH_T(which), who) ); RETURN; #else DIE(aTHX_ PL_no_func, "getpriority()"); - return NORMAL; #endif } @@ -4489,14 +4398,15 @@ PP(pp_setpriority) const int who = POPi; const int which = TOPi; TAINT_PROPER("setpriority"); - SETi( setpriority(which, who, niceval) >= 0 ); + SETi( setpriority(PRIORITY_WHICH_T(which), who, niceval) >= 0 ); RETURN; #else DIE(aTHX_ PL_no_func, "setpriority()"); - return NORMAL; #endif } +#undef PRIORITY_WHICH_T + /* Time calls. */ PP(pp_time) @@ -4544,7 +4454,6 @@ PP(pp_tms) RETURN; # else DIE(aTHX_ "times not implemented"); - return NORMAL; # endif #endif /* HAS_TIMES */ } @@ -4661,7 +4570,6 @@ PP(pp_alarm) RETURN; #else DIE(aTHX_ PL_no_func, "alarm"); - return NORMAL; #endif } @@ -4713,7 +4621,7 @@ PP(pp_shmwrite) PUSHi(value); RETURN; #else - return pp_semget(); + return Perl_pp_semget(aTHX); #endif } @@ -4731,7 +4639,6 @@ PP(pp_semget) RETURN; #else DIE(aTHX_ "System V IPC is not implemented on this machine"); - return NORMAL; #endif } @@ -4751,7 +4658,7 @@ PP(pp_semctl) } RETURN; #else - return pp_semget(); + return Perl_pp_semget(aTHX); #endif } @@ -4866,8 +4773,7 @@ PP(pp_ghostent) } RETURN; #else - DIE(aTHX_ PL_no_sock_func, "gethostent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif } @@ -4940,8 +4846,7 @@ PP(pp_gnetent) RETURN; #else - DIE(aTHX_ PL_no_sock_func, "getnetent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif } @@ -5001,8 +4906,7 @@ PP(pp_gprotoent) RETURN; #else - DIE(aTHX_ PL_no_sock_func, "getprotoent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif } @@ -5077,109 +4981,110 @@ PP(pp_gservent) RETURN; #else - DIE(aTHX_ PL_no_sock_func, "getservent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif } PP(pp_shostent) { -#ifdef HAS_SETHOSTENT dVAR; dSP; - PerlSock_sethostent(TOPi); - RETSETYES; + const int stayopen = TOPi; + switch(PL_op->op_type) { + case OP_SHOSTENT: +#ifdef HAS_SETHOSTENT + PerlSock_sethostent(stayopen); #else - DIE(aTHX_ PL_no_sock_func, "sethostent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif -} - -PP(pp_snetent) -{ + break; #ifdef HAS_SETNETENT - dVAR; dSP; - (void)PerlSock_setnetent(TOPi); - RETSETYES; + case OP_SNETENT: + PerlSock_setnetent(stayopen); #else - DIE(aTHX_ PL_no_sock_func, "setnetent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif -} - -PP(pp_sprotoent) -{ + break; + case OP_SPROTOENT: #ifdef HAS_SETPROTOENT - dVAR; dSP; - (void)PerlSock_setprotoent(TOPi); - RETSETYES; + PerlSock_setprotoent(stayopen); #else - DIE(aTHX_ PL_no_sock_func, "setprotoent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif -} - -PP(pp_sservent) -{ + break; + case OP_SSERVENT: #ifdef HAS_SETSERVENT - dVAR; dSP; - (void)PerlSock_setservent(TOPi); - RETSETYES; + PerlSock_setservent(stayopen); #else - DIE(aTHX_ PL_no_sock_func, "setservent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif + break; + } + RETSETYES; } PP(pp_ehostent) { -#ifdef HAS_ENDHOSTENT dVAR; dSP; - PerlSock_endhostent(); - EXTEND(SP,1); - RETPUSHYES; + switch(PL_op->op_type) { + case OP_EHOSTENT: +#ifdef HAS_ENDHOSTENT + PerlSock_endhostent(); #else - DIE(aTHX_ PL_no_sock_func, "endhostent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif -} - -PP(pp_enetent) -{ + break; + case OP_ENETENT: #ifdef HAS_ENDNETENT - dVAR; dSP; - PerlSock_endnetent(); - EXTEND(SP,1); - RETPUSHYES; + PerlSock_endnetent(); #else - DIE(aTHX_ PL_no_sock_func, "endnetent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif -} - -PP(pp_eprotoent) -{ + break; + case OP_EPROTOENT: #ifdef HAS_ENDPROTOENT - dVAR; dSP; - PerlSock_endprotoent(); - EXTEND(SP,1); - RETPUSHYES; + PerlSock_endprotoent(); #else - DIE(aTHX_ PL_no_sock_func, "endprotoent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif -} - -PP(pp_eservent) -{ + break; + case OP_ESERVENT: #ifdef HAS_ENDSERVENT - dVAR; dSP; - PerlSock_endservent(); - EXTEND(SP,1); - RETPUSHYES; + PerlSock_endservent(); #else - DIE(aTHX_ PL_no_sock_func, "endservent"); - return NORMAL; + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); +#endif + break; + case OP_SGRENT: +#if defined(HAS_GROUP) && defined(HAS_SETGRENT) + setgrent(); +#else + DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); +#endif + break; + case OP_EGRENT: +#if defined(HAS_GROUP) && defined(HAS_ENDGRENT) + endgrent(); +#else + DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); +#endif + break; + case OP_SPWENT: +#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) + setpwent(); +#else + DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); +#endif + break; + case OP_EPWENT: +#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT) + endpwent(); +#else + DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); #endif + break; + } + EXTEND(SP,1); + RETPUSHYES; } PP(pp_gpwent) @@ -5325,7 +5230,7 @@ PP(pp_gpwent) const struct spwd * const spwent = getspnam(pwent->pw_name); /* Save and restore errno so that * underprivileged attempts seem - * to have never made the unsccessful + * to have never made the unsuccessful * attempt to retrieve the shadow password. */ RESTORE_ERRNO; if (spwent && spwent->sp_pwdp) @@ -5412,31 +5317,6 @@ PP(pp_gpwent) RETURN; #else DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); - return NORMAL; -#endif -} - -PP(pp_spwent) -{ -#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) - dVAR; dSP; - setpwent(); - RETPUSHYES; -#else - DIE(aTHX_ PL_no_func, "setpwent"); - return NORMAL; -#endif -} - -PP(pp_epwent) -{ -#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT) - dVAR; dSP; - endpwent(); - RETPUSHYES; -#else - DIE(aTHX_ PL_no_func, "endpwent"); - return NORMAL; #endif } @@ -5511,31 +5391,6 @@ PP(pp_ggrent) RETURN; #else DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); - return NORMAL; -#endif -} - -PP(pp_sgrent) -{ -#if defined(HAS_GROUP) && defined(HAS_SETGRENT) - dVAR; dSP; - setgrent(); - RETPUSHYES; -#else - DIE(aTHX_ PL_no_func, "setgrent"); - return NORMAL; -#endif -} - -PP(pp_egrent) -{ -#if defined(HAS_GROUP) && defined(HAS_ENDGRENT) - dVAR; dSP; - endgrent(); - RETPUSHYES; -#else - DIE(aTHX_ PL_no_func, "endgrent"); - return NORMAL; #endif } @@ -5547,11 +5402,11 @@ PP(pp_getlogin) EXTEND(SP, 1); if (!(tmps = PerlProc_getlogin())) RETPUSHUNDEF; - PUSHp(tmps, strlen(tmps)); + sv_setpv_mg(TARG, tmps); + PUSHs(TARG); RETURN; #else DIE(aTHX_ PL_no_func, "getlogin"); - return NORMAL; #endif } @@ -5650,7 +5505,6 @@ PP(pp_syscall) RETURN; #else DIE(aTHX_ PL_no_func, "syscall"); - return NORMAL; #endif }