X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/75af1a9c52a124d2be09fece4ba0d7bc6091ed01..658b4a4a328256e2a80066c57ca7866646757dad:/pp_sys.c?ds=sidebyside diff --git a/pp_sys.c b/pp_sys.c index bb843e1..4e2b412 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -45,12 +45,6 @@ # include #endif -#ifdef HAS_SYSCALL -#ifdef __cplusplus -extern "C" int syscall(unsigned long,...); -#endif -#endif - #ifdef I_SYS_WAIT # include #endif @@ -125,6 +119,12 @@ extern int h_errno; # undef my_chsize # endif # define my_chsize PerlLIO_chsize +#else +# ifdef HAS_TRUNCATE +# define my_chsize PerlLIO_chsize +# else +I32 my_chsize(int fd, Off_t length); +# endif #endif #ifdef HAS_FLOCK @@ -173,7 +173,7 @@ extern int h_errno; #endif /* no flock() */ #define ZBTLEN 10 -static char zero_but_true[ZBTLEN + 1] = "0 but true"; +static const char zero_but_true[ZBTLEN + 1] = "0 but true"; #if defined(I_SYS_ACCESS) && !defined(R_OK) # include @@ -309,6 +309,8 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) STATIC int S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) { + (void)path; + (void)mode; Perl_croak(aTHX_ "switching effective uid is not implemented"); /*NOTREACHED*/ return -1; @@ -319,21 +321,20 @@ PP(pp_backtick) { dSP; dTARGET; PerlIO *fp; - STRLEN n_a; - char *tmps = POPpx; - I32 gimme = GIMME_V; - char *mode = "r"; + const char *tmps = POPpconstx; + const I32 gimme = GIMME_V; + const char *mode = "r"; TAINT_PROPER("``"); if (PL_op->op_private & OPpOPEN_IN_RAW) mode = "rb"; else if (PL_op->op_private & OPpOPEN_IN_CRLF) mode = "rt"; - fp = PerlProc_popen(tmps, mode); + fp = PerlProc_popen((char*)tmps, (char *)mode); if (fp) { - char *type = NULL; + const char *type = NULL; if (PL_curcop->cop_io) { - type = SvPV_nolen(PL_curcop->cop_io); + type = SvPV_nolen_const(PL_curcop->cop_io); } if (type && *type) PerlIO_apply_layers(aTHX_ fp,mode,type); @@ -348,7 +349,7 @@ PP(pp_backtick) ENTER; SAVESPTR(PL_rs); PL_rs = &PL_sv_undef; - sv_setpv(TARG, ""); /* note that this preserves previous buffer */ + sv_setpvn(TARG, "", 0); /* note that this preserves previous buffer */ while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch) /*SUPPRESS 530*/ ; @@ -367,8 +368,7 @@ PP(pp_backtick) } XPUSHs(sv_2mortal(sv)); if (SvLEN(sv) - SvCUR(sv) > 20) { - SvLEN_set(sv, SvCUR(sv)+1); - Renew(SvPVX(sv), SvLEN(sv), char); + SvPV_shrink_to_cur(sv); } SvTAINTED_on(sv); } @@ -387,6 +387,7 @@ PP(pp_backtick) PP(pp_glob) { + dVAR; OP *result; tryAMAGICunTARGET(iter, -1); @@ -433,7 +434,7 @@ PP(pp_warn) { dSP; dMARK; SV *tmpsv; - char *tmps; + const char *tmps; STRLEN len; if (SP - MARK != 1) { dTARGET; @@ -444,14 +445,14 @@ PP(pp_warn) else { tmpsv = TOPs; } - tmps = SvPV(tmpsv, len); + tmps = SvPV_const(tmpsv, len); if ((!tmps || !len) && PL_errgv) { SV *error = ERRSV; - (void)SvUPGRADE(error, SVt_PV); + SvUPGRADE(error, SVt_PV); if (SvPOK(error) && SvCUR(error)) sv_catpv(error, "\t...caught"); tmpsv = error; - tmps = SvPV(tmpsv, len); + tmps = SvPV_const(tmpsv, len); } if (!tmps || !len) tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26)); @@ -463,7 +464,7 @@ PP(pp_warn) PP(pp_die) { dSP; dMARK; - char *tmps; + const char *tmps; SV *tmpsv; STRLEN len; bool multiarg = 0; @@ -474,17 +475,17 @@ PP(pp_die) dTARGET; do_join(TARG, &PL_sv_no, MARK, SP); tmpsv = TARG; - tmps = SvPV(tmpsv, len); + tmps = SvPV_const(tmpsv, len); multiarg = 1; SP = MARK + 1; } else { tmpsv = TOPs; - tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, len); + tmps = SvROK(tmpsv) ? Nullch : SvPV_const(tmpsv, len); } if (!tmps || !len) { SV *error = ERRSV; - (void)SvUPGRADE(error, SVt_PV); + SvUPGRADE(error, SVt_PV); if (multiarg ? SvROK(error) : SvROK(tmpsv)) { if (!multiarg) SvSetSV(error,tmpsv); @@ -511,7 +512,7 @@ PP(pp_die) if (SvPOK(error) && SvCUR(error)) sv_catpv(error, "\t...propagated"); tmpsv = error; - tmps = SvPV(tmpsv, len); + tmps = SvPV_const(tmpsv, len); } } if (!tmps || !len) @@ -524,13 +525,13 @@ PP(pp_die) PP(pp_open) { - dSP; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; GV *gv; SV *sv; IO *io; - char *tmps; + const char *tmps; STRLEN len; MAGIC *mg; bool ok; @@ -561,8 +562,8 @@ PP(pp_open) sv = GvSV(gv); } - tmps = SvPV(sv, len); - ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK)); + tmps = SvPV_const(sv, len); + ok = do_openn(gv, (char *)tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK)); SP = ORIGMARK; if (ok) PUSHi( (I32)PL_forkprocess ); @@ -575,7 +576,7 @@ PP(pp_open) PP(pp_close) { - dSP; + dVAR; dSP; GV *gv; IO *io; MAGIC *mg; @@ -660,7 +661,7 @@ badexit: PP(pp_fileno) { - dSP; dTARGET; + dVAR; dSP; dTARGET; GV *gv; IO *io; PerlIO *fp; @@ -698,8 +699,9 @@ PP(pp_fileno) PP(pp_umask) { - dSP; dTARGET; + dSP; #ifdef HAS_UMASK + dTARGET; Mode_t anum; if (MAXARG < 1) { @@ -711,7 +713,7 @@ PP(pp_umask) TAINT_PROPER("umask"); XPUSHi(anum); #else - /* Only DIE if trying to restrict permissions on `user' (self). + /* Only DIE if trying to restrict permissions on "user" (self). * Otherwise it's harmless and more useful to just return undef * since 'group' and 'other' concepts probably don't exist here. */ if (MAXARG >= 1 && (POPi & 0700)) @@ -723,7 +725,7 @@ PP(pp_umask) PP(pp_binmode) { - dSP; + dVAR; dSP; GV *gv; IO *io; PerlIO *fp; @@ -763,11 +765,11 @@ PP(pp_binmode) PUTBACK; if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp), - (discp) ? SvPV_nolen(discp) : Nullch)) { + (discp) ? SvPV_nolen_const(discp) : Nullch)) { if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io), mode_from_discipline(discp), - (discp) ? SvPV_nolen(discp) : Nullch)) { + (discp) ? SvPV_nolen_const(discp) : Nullch)) { SPAGAIN; RETPUSHUNDEF; } @@ -783,14 +785,13 @@ PP(pp_binmode) PP(pp_tie) { - dSP; - dMARK; + dVAR; dSP; dMARK; SV *varsv; HV* stash; GV *gv; SV *sv; - I32 markoff = MARK - PL_stack_base; - char *methname; + const I32 markoff = MARK - PL_stack_base; + const char *methname; int how = PERL_MAGIC_tied; U32 items; @@ -798,7 +799,7 @@ PP(pp_tie) switch(SvTYPE(varsv)) { case SVt_PVHV: methname = "TIEHASH"; - HvEITER((HV *)varsv) = Null(HE *); + HvEITER_set((HV *)varsv, 0); break; case SVt_PVAV: methname = "TIEARRAY"; @@ -873,10 +874,10 @@ PP(pp_tie) PP(pp_untie) { - dSP; + dVAR; dSP; MAGIC *mg; SV *sv = POPs; - char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv))) @@ -915,7 +916,7 @@ PP(pp_tied) dSP; MAGIC *mg; SV *sv = POPs; - char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv))) @@ -933,7 +934,7 @@ PP(pp_tied) PP(pp_dbmopen) { - dSP; + dVAR; dSP; HV *hv; dPOPPOPssrl; HV* stash; @@ -1008,7 +1009,6 @@ PP(pp_sselect) struct timeval *tbuf = &timebuf; I32 growsize; char *fd_sets[4]; - STRLEN n_a; #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 I32 masksize; I32 offset; @@ -1024,9 +1024,16 @@ PP(pp_sselect) SP -= 4; for (i = 1; i <= 3; i++) { - if (!SvPOK(SP[i])) + SV *sv = SP[i]; + if (SvOK(sv) && SvREADONLY(sv)) { + if (SvIsCOW(sv)) + sv_force_normal_flags(sv, 0); + if (SvREADONLY(sv)) + DIE(aTHX_ PL_no_modify); + } + if (!SvPOK(sv)) continue; - j = SvCUR(SP[i]); + j = SvCUR(sv); if (maxlen < j) maxlen = j; } @@ -1080,7 +1087,7 @@ PP(pp_sselect) continue; } else if (!SvPOK(sv)) - SvPV_force(sv,n_a); /* force string conversion */ + SvPV_force_nolen(sv); /* force string conversion */ j = SvLEN(sv); if (j < growsize) { Sv_Grow(sv, growsize); @@ -1135,7 +1142,10 @@ PP(pp_sselect) } } - PUSHi(nfound); + if (nfound == -1) + PUSHs(&PL_sv_undef); + else + PUSHi(nfound); if (GIMME == G_ARRAY && tbuf) { value = (NV)(timebuf.tv_sec) + (NV)(timebuf.tv_usec) / 1000000.0; @@ -1161,10 +1171,10 @@ Perl_setdefout(pTHX_ GV *gv) PP(pp_select) { dSP; dTARGET; - GV *newdefout, *egv; + GV *egv; HV *hv; - newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL; + GV * const newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL; egv = GvEGV(PL_defoutgv); if (!egv) @@ -1194,7 +1204,7 @@ PP(pp_select) PP(pp_getc) { - dSP; dTARGET; + dVAR; dSP; dTARGET; GV *gv; IO *io = NULL; MAGIC *mg; @@ -1207,7 +1217,7 @@ PP(pp_getc) if (gv && (io = GvIO(gv)) && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) { - I32 gimme = GIMME_V; + const I32 gimme = GIMME_V; PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)io, mg)); PUTBACK; @@ -1227,11 +1237,11 @@ PP(pp_getc) RETPUSHUNDEF; } TAINT; - sv_setpv(TARG, " "); + sv_setpvn(TARG, " ", 1); *SvPVX(TARG) = PerlIO_getc(IoIFP(GvIOp(gv))); /* should never be EOF */ if (PerlIO_isutf8(IoIFP(GvIOp(gv)))) { /* Find out how many bytes the char needs */ - Size_t len = UTF8SKIP(SvPVX(TARG)); + Size_t len = UTF8SKIP(SvPVX_const(TARG)); if (len > 1) { SvGROW(TARG,len+1); len = PerlIO_read(IoIFP(GvIOp(gv)),SvPVX(TARG)+1,len-1); @@ -1251,8 +1261,9 @@ PP(pp_read) STATIC OP * S_doform(pTHX_ CV *cv, GV *gv, OP *retop) { + dVAR; register PERL_CONTEXT *cx; - I32 gimme = GIMME_V; + const I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -1293,14 +1304,14 @@ PP(pp_enterwrite) cv = GvFORM(fgv); if (!cv) { - char *name = NULL; if (fgv) { - SV *tmpsv = sv_newmortal(); + SV * const tmpsv = sv_newmortal(); + const char *name; gv_efullname4(tmpsv, fgv, Nullch, FALSE); - name = SvPV_nolen(tmpsv); + name = SvPV_nolen_const(tmpsv); + if (name && *name) + DIE(aTHX_ "Undefined format \"%s\" called", name); } - if (name && *name) - DIE(aTHX_ "Undefined format \"%s\" called", name); DIE(aTHX_ "Not a format reference"); } if (CvCLONE(cv)) @@ -1312,7 +1323,7 @@ PP(pp_enterwrite) PP(pp_leavewrite) { - dSP; + dVAR; dSP; GV *gv = cxstack[cxstack_ix].blk_sub.gv; register IO *io = GvIOp(gv); PerlIO *ofp = IoOFP(io); @@ -1347,14 +1358,14 @@ PP(pp_leavewrite) } topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM); if (!topgv || !GvFORM(topgv)) { - IoLINES_LEFT(io) = 100000000; + IoLINES_LEFT(io) = IoPAGE_LEN(io); goto forget_top; } IoTOP_GV(io) = topgv; } if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear. It still doesn't fit. */ I32 lines = IoLINES_LEFT(io); - char *s = SvPVX(PL_formtarget); + const char *s = SvPVX_const(PL_formtarget); if (lines <= 0) /* Yow, header didn't even fit!!! */ goto forget_top; while (lines-- > 0) { @@ -1364,8 +1375,8 @@ PP(pp_leavewrite) s++; } if (s) { - STRLEN save = SvCUR(PL_formtarget); - SvCUR_set(PL_formtarget, s - SvPVX(PL_formtarget)); + const STRLEN save = SvCUR(PL_formtarget); + SvCUR_set(PL_formtarget, s - SvPVX_const(PL_formtarget)); do_print(PL_formtarget, ofp); SvCUR_set(PL_formtarget, save); sv_chop(PL_formtarget, s); @@ -1382,20 +1393,18 @@ PP(pp_leavewrite) if (!fgv) DIE(aTHX_ "bad top format reference"); cv = GvFORM(fgv); - { - char *name = NULL; - if (!cv) { - SV *sv = sv_newmortal(); - gv_efullname4(sv, fgv, Nullch, FALSE); - name = SvPV_nolen(sv); - } + if (!cv) { + SV * const sv = sv_newmortal(); + const char *name; + gv_efullname4(sv, fgv, Nullch, FALSE); + name = SvPV_nolen_const(sv); if (name && *name) - DIE(aTHX_ "Undefined top format \"%s\" called",name); - /* why no: - else - DIE(aTHX_ "Undefined top format called"); - ?*/ + DIE(aTHX_ "Undefined top format \"%s\" called",name); } + /* why no: + else + DIE(aTHX_ "Undefined top format called"); + ?*/ if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); return doform(cv,gv,PL_op); @@ -1440,7 +1449,7 @@ PP(pp_leavewrite) PP(pp_prtf) { - dSP; dMARK; dORIGMARK; + dVAR; dSP; dMARK; dORIGMARK; GV *gv; IO *io; PerlIO *fp; @@ -1517,22 +1526,19 @@ PP(pp_sysopen) dSP; GV *gv; SV *sv; - char *tmps; + const char *tmps; STRLEN len; - int mode, perm; + const int perm = (MAXARG > 3) ? POPi : 0666; + const int mode = POPi; - if (MAXARG > 3) - perm = POPi; - else - perm = 0666; - mode = POPi; sv = POPs; gv = (GV *)POPs; /* Need TIEHANDLE method ? */ - tmps = SvPV(sv, len); - if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) { + tmps = SvPV_const(sv, len); + /* FIXME? do_open should do const */ + if (do_open(gv, (char*)tmps, len, TRUE, mode, perm, Nullfp)) { IoLINES(GvIOp(gv)) = 0; PUSHs(&PL_sv_yes); } @@ -1544,7 +1550,7 @@ PP(pp_sysopen) PP(pp_sysread) { - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; int offset; GV *gv; IO *io; @@ -1683,7 +1689,7 @@ PP(pp_sysread) (should be 2 * length + offset + 1, or possibly something longer if PL_encoding is true) */ buffer = SvGROW(bufsv, (STRLEN)(length+offset+1)); - if (offset > bufsize) { /* Zero any newly allocated space */ + if (offset > 0 && (Sock_size_t)offset > bufsize) { /* Zero any newly allocated space */ Zero(buffer+bufsize, offset-bufsize, char); } buffer = buffer + offset; @@ -1699,7 +1705,7 @@ PP(pp_sysread) read_target = sv_newmortal(); SvUPGRADE(read_target, SVt_PV); - buffer = SvGROW(read_target, length + 1); + buffer = SvGROW(read_target, (STRLEN)(length + 1)); } if (PL_op->op_type == OP_SYSREAD) { @@ -1740,12 +1746,12 @@ PP(pp_sysread) report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY); goto say_undef; } - SvCUR_set(read_target, count+(buffer - SvPVX(read_target))); + SvCUR_set(read_target, count+(buffer - SvPVX_const(read_target))); *SvEND(read_target) = '\0'; (void)SvPOK_only(read_target); if (fp_utf8 && !IN_BYTES) { /* Look at utf8 we got back and count the characters */ - char *bend = buffer + count; + const char *bend = buffer + count; while (buffer < bend) { if (charstart) { skip = UTF8SKIP(buffer); @@ -1754,7 +1760,7 @@ PP(pp_sysread) if (buffer - charskip + skip > bend) { /* partial character - try for rest of it */ length = skip - (bend-buffer); - offset = bend - SvPVX(bufsv); + offset = bend - SvPVX_const(bufsv); charstart = FALSE; charskip += count; goto more_bytes; @@ -1771,7 +1777,7 @@ PP(pp_sysread) */ if (got < wanted && count == length) { length = wanted - got; - offset = bend - SvPVX(bufsv); + offset = bend - SvPVX_const(bufsv); goto more_bytes; } /* return value is character count */ @@ -1798,8 +1804,8 @@ PP(pp_sysread) PP(pp_syswrite) { - dSP; - int items = (SP - PL_stack_base) - TOPMARK; + dVAR; dSP; + const int items = (SP - PL_stack_base) - TOPMARK; if (items == 2) { SV *sv; EXTEND(SP, 1); @@ -1812,11 +1818,11 @@ PP(pp_syswrite) PP(pp_send) { - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; GV *gv; IO *io; SV *bufsv; - char *buffer; + const char *buffer; Size_t length; SSize_t retval; STRLEN blen; @@ -1865,7 +1871,7 @@ PP(pp_send) bufsv = sv_2mortal(newSVsv(bufsv)); buffer = sv_2pvutf8(bufsv, &blen); } else - buffer = SvPV(bufsv, blen); + buffer = SvPV_const(bufsv, blen); } else { if (DO_UTF8(bufsv)) { @@ -1873,7 +1879,7 @@ PP(pp_send) bufsv = sv_2mortal(newSVsv(bufsv)); sv_utf8_downgrade(bufsv, FALSE); } - buffer = SvPV(bufsv, blen); + buffer = SvPV_const(bufsv, blen); } if (PL_op->op_type == OP_SYSWRITE) { @@ -1895,7 +1901,7 @@ PP(pp_send) if (length > blen - offset) length = blen - offset; if (DO_UTF8(bufsv)) { - buffer = (char*)utf8_hop((U8 *)buffer, offset); + buffer = (const char*)utf8_hop((const U8 *)buffer, offset); length = utf8_hop((U8 *)buffer, length) - (U8 *)buffer; } else { @@ -1916,9 +1922,8 @@ PP(pp_send) } #ifdef HAS_SOCKET else if (SP > MARK) { - char *sockbuf; STRLEN mlen; - sockbuf = SvPVx(*++MARK, 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); @@ -1954,7 +1959,7 @@ PP(pp_recv) PP(pp_eof) { - dSP; + dVAR; dSP; GV *gv; IO *io; MAGIC *mg; @@ -1968,7 +1973,7 @@ PP(pp_eof) if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) { IoLINES(io) = 0; IoFLAGS(io) &= ~IOf_START; - do_open(gv, "-", 1, FALSE, O_RDONLY, 0, Nullfp); + do_open(gv, (char *)"-", 1, FALSE, O_RDONLY, 0, Nullfp); sv_setpvn(GvSV(gv), "-", 1); SvSETMAGIC(GvSV(gv)); } @@ -2001,7 +2006,7 @@ PP(pp_eof) PP(pp_tell) { - dSP; dTARGET; + dVAR; dSP; dTARGET; GV *gv; IO *io; MAGIC *mg; @@ -2039,10 +2044,10 @@ PP(pp_seek) PP(pp_sysseek) { - dSP; + dVAR; dSP; GV *gv; IO *io; - int whence = POPi; + const int whence = POPi; #if LSEEKSIZE > IVSIZE Off_t offset = (Off_t)SvNVx(POPs); #else @@ -2110,7 +2115,6 @@ PP(pp_truncate) * might not be signed: if it is not, clever compilers will moan. */ /* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */ SETERRNO(0,0); -#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP) { int result = 1; GV *tmpgv; @@ -2143,8 +2147,7 @@ PP(pp_truncate) } else { SV *sv = POPs; - char *name; - STRLEN n_a; + const char *name; if (SvTYPE(sv) == SVt_PVGV) { tmpgv = (GV*)sv; /* *main::FRED for example */ @@ -2159,7 +2162,7 @@ PP(pp_truncate) goto do_ftruncate_io; } - name = SvPV(sv, n_a); + name = SvPV_nolen_const(sv); TAINT_PROPER("truncate"); #ifdef HAS_TRUNCATE if (truncate(name, len) < 0) @@ -2185,9 +2188,6 @@ PP(pp_truncate) SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; } -#else - DIE(aTHX_ "truncate not implemented"); -#endif } PP(pp_fcntl) @@ -2199,8 +2199,8 @@ PP(pp_ioctl) { dSP; dTARGET; SV *argsv = POPs; - unsigned int func = POPu; - int optype = PL_op->op_type; + const unsigned int func = POPu; + const int optype = PL_op->op_type; char *s; IV retval; GV *gv = (GV*)POPs; @@ -2437,7 +2437,8 @@ PP(pp_bind) extern void GETUSERMODE(); #endif SV *addrsv = POPs; - char *addr; + /* OK, so on what platform does bind modify addr? */ + const char *addr; GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); STRLEN len; @@ -2449,7 +2450,7 @@ PP(pp_bind) if (!io || !IoIFP(io)) goto nuts; - addr = SvPV(addrsv, len); + addr = SvPV_const(addrsv, len); TAINT_PROPER("bind"); #ifdef MPE /* Deal with MPE bind() peculiarities */ if (((struct sockaddr *)addr)->sa_family == AF_INET) { @@ -2492,7 +2493,7 @@ PP(pp_connect) #ifdef HAS_SOCKET dSP; SV *addrsv = POPs; - char *addr; + const char *addr; GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); STRLEN len; @@ -2500,7 +2501,7 @@ PP(pp_connect) if (!io || !IoIFP(io)) goto nuts; - addr = SvPV(addrsv, len); + addr = SvPV_const(addrsv, len); TAINT_PROPER("connect"); if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0) RETPUSHYES; @@ -2687,16 +2688,16 @@ PP(pp_ssockopt) PUSHs(sv); break; case OP_SSOCKOPT: { - char *buf; + const char *buf; int aint; if (SvPOKp(sv)) { STRLEN l; - buf = SvPV(sv, l); + buf = SvPV_const(sv, l); len = l; } else { aint = (int)SvIV(sv); - buf = (char*)&aint; + buf = (const char*)&aint; len = sizeof(int); } if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0) @@ -2760,8 +2761,8 @@ PP(pp_getpeername) { static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; /* If the call succeeded, make sure we don't have a zeroed port/addr */ - if (((struct sockaddr *)SvPVX(sv))->sa_family == AF_INET && - !memcmp((char *)SvPVX(sv) + sizeof(u_short), nowhere, + if (((struct sockaddr *)SvPVX_const(sv))->sa_family == AF_INET && + !memcmp((char *)SvPVX_const(sv) + sizeof(u_short), nowhere, sizeof(u_short) + sizeof(struct in_addr))) { goto nuts2; } @@ -2805,7 +2806,6 @@ PP(pp_stat) GV *gv; I32 gimme; I32 max = 13; - STRLEN n_a; if (PL_op->op_flags & OPf_REF) { gv = cGVOP_gv; @@ -2822,7 +2822,7 @@ PP(pp_stat) if (gv != PL_defgv) { PL_laststype = OP_STAT; PL_statgv = gv; - sv_setpv(PL_statname, ""); + sv_setpvn(PL_statname, "", 0); PL_laststatval = (GvIO(gv) && IoIFP(GvIOp(gv)) ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache) : -1); } @@ -2845,15 +2845,15 @@ PP(pp_stat) "lstat() on filehandle %s", GvENAME(gv)); goto do_fstat; } - sv_setpv(PL_statname, SvPV(sv,n_a)); + sv_setpv(PL_statname, SvPV_nolen_const(sv)); PL_statgv = Nullgv; PL_laststype = PL_op->op_type; if (PL_op->op_type == OP_LSTAT) - PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache); + PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache); else - PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache); + PL_laststatval = PerlLIO_stat(SvPV_nolen_const(PL_statname), &PL_statcache); if (PL_laststatval < 0) { - if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n')) + if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), '\n')) Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); max = 0; } @@ -2936,7 +2936,6 @@ PP(pp_ftrread) STACKED_FTEST_CHECK; #if defined(HAS_ACCESS) && defined(R_OK) if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - STRLEN n_a; result = access(POPpx, R_OK); if (result == 0) RETPUSHYES; @@ -2964,7 +2963,6 @@ PP(pp_ftrwrite) STACKED_FTEST_CHECK; #if defined(HAS_ACCESS) && defined(W_OK) if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - STRLEN n_a; result = access(POPpx, W_OK); if (result == 0) RETPUSHYES; @@ -2992,7 +2990,6 @@ PP(pp_ftrexec) STACKED_FTEST_CHECK; #if defined(HAS_ACCESS) && defined(X_OK) if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - STRLEN n_a; result = access(POPpx, X_OK); if (result == 0) RETPUSHYES; @@ -3020,7 +3017,6 @@ PP(pp_fteread) STACKED_FTEST_CHECK; #ifdef PERL_EFF_ACCESS_R_OK if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - STRLEN n_a; result = PERL_EFF_ACCESS_R_OK(POPpx); if (result == 0) RETPUSHYES; @@ -3048,7 +3044,6 @@ PP(pp_ftewrite) STACKED_FTEST_CHECK; #ifdef PERL_EFF_ACCESS_W_OK if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - STRLEN n_a; result = PERL_EFF_ACCESS_W_OK(POPpx); if (result == 0) RETPUSHYES; @@ -3076,7 +3071,6 @@ PP(pp_fteexec) STACKED_FTEST_CHECK; #ifdef PERL_EFF_ACCESS_X_OK if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - STRLEN n_a; result = PERL_EFF_ACCESS_X_OK(POPpx); if (result == 0) RETPUSHYES; @@ -3363,8 +3357,7 @@ PP(pp_fttty) if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (tmpsv && SvOK(tmpsv)) { - STRLEN n_a; - char *tmps = SvPV(tmpsv, n_a); + const char *tmps = SvPV_nolen_const(tmpsv); if (isDIGIT(*tmps)) fd = atoi(tmps); else @@ -3396,7 +3389,6 @@ PP(pp_fttext) register IO *io; register SV *sv; GV *gv; - STRLEN n_a; PerlIO *fp; STACKED_FTEST_CHECK; @@ -3423,7 +3415,7 @@ PP(pp_fttext) else { PL_statgv = gv; PL_laststatval = -1; - sv_setpv(PL_statname, ""); + sv_setpvn(PL_statname, "", 0); io = GvIO(PL_statgv); } if (io && IoIFP(io)) { @@ -3464,11 +3456,11 @@ PP(pp_fttext) sv = POPs; really_filename: PL_statgv = Nullgv; - PL_laststatval = -1; PL_laststype = OP_STAT; - sv_setpv(PL_statname, SvPV(sv, n_a)); - if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) { - if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n')) + sv_setpv(PL_statname, SvPV_nolen_const(sv)); + if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) { + if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), + '\n')) Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open"); RETPUSHUNDEF; } @@ -3552,12 +3544,11 @@ PP(pp_ftbinary) PP(pp_chdir) { dSP; dTARGET; - char *tmps; + const char *tmps; SV **svp; - STRLEN n_a; if( MAXARG == 1 ) - tmps = POPpx; + tmps = POPpconstx; else tmps = 0; @@ -3571,7 +3562,7 @@ PP(pp_chdir) { if( MAXARG == 1 ) deprecate("chdir('') or chdir(undef) as chdir()"); - tmps = SvPV(*svp, n_a); + tmps = SvPV_nolen_const(*svp); } else { PUSHi(0); @@ -3608,7 +3599,6 @@ PP(pp_chroot) { #ifdef HAS_CHROOT dSP; dTARGET; - STRLEN n_a; char *tmps = POPpx; TAINT_PROPER("chroot"); PUSHi( chroot(tmps) >= 0 ); @@ -3652,10 +3642,8 @@ PP(pp_rename) { dSP; dTARGET; int anum; - STRLEN n_a; - - char *tmps2 = POPpx; - char *tmps = SvPV(TOPs, n_a); + const char *tmps2 = POPpconstx; + const char *tmps = SvPV_nolen_const(TOPs); TAINT_PROPER("rename"); #ifdef HAS_RENAME anum = PerlLIO_rename(tmps, tmps2); @@ -3679,9 +3667,8 @@ PP(pp_link) { #ifdef HAS_LINK dSP; dTARGET; - STRLEN n_a; - char *tmps2 = POPpx; - char *tmps = SvPV(TOPs, n_a); + const char *tmps2 = POPpconstx; + const char *tmps = SvPV_nolen_const(TOPs); TAINT_PROPER("link"); SETi( PerlLIO_link(tmps, tmps2) >= 0 ); RETURN; @@ -3694,9 +3681,8 @@ PP(pp_symlink) { #ifdef HAS_SYMLINK dSP; dTARGET; - STRLEN n_a; - char *tmps2 = POPpx; - char *tmps = SvPV(TOPs, n_a); + const char *tmps2 = POPpconstx; + const char *tmps = SvPV_nolen_const(TOPs); TAINT_PROPER("symlink"); SETi( symlink(tmps, tmps2) >= 0 ); RETURN; @@ -3710,15 +3696,14 @@ PP(pp_readlink) dSP; #ifdef HAS_SYMLINK dTARGET; - char *tmps; + const char *tmps; char buf[MAXPATHLEN]; int len; - STRLEN n_a; #ifndef INCOMPLETE_TAINTS TAINT; #endif - tmps = POPpx; + tmps = POPpconstx; len = readlink(tmps, buf, sizeof(buf) - 1); EXTEND(SP, 1); if (len < 0) @@ -3733,9 +3718,9 @@ PP(pp_readlink) #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) STATIC int -S_dooneliner(pTHX_ char *cmd, char *filename) +S_dooneliner(pTHX_ const char *cmd, const char *filename) { - char *save_filename = filename; + char * const save_filename = filename; char *cmdline; char *s; PerlIO *myfp; @@ -3829,7 +3814,7 @@ S_dooneliner(pTHX_ char *cmd, char *filename) * -d, chdir(), chmod(), chown(), chroot(), fcntl()?, * (mkdir()), opendir(), rename(), rmdir(), stat(). --jhi */ -#define TRIMSLASHES(tmps,len,copy) (tmps) = SvPV(TOPs, (len)); \ +#define TRIMSLASHES(tmps,len,copy) (tmps) = SvPV_const(TOPs, (len)); \ if ((len) > 1 && (tmps)[(len)-1] == '/') { \ do { \ (len)--; \ @@ -3846,7 +3831,7 @@ PP(pp_mkdir) int oldumask; #endif STRLEN len; - char *tmps; + const char *tmps; bool copy = FALSE; if (MAXARG > 1) @@ -3874,7 +3859,7 @@ PP(pp_rmdir) { dSP; dTARGET; STRLEN len; - char *tmps; + const char *tmps; bool copy = FALSE; TRIMSLASHES(tmps,len,copy); @@ -3895,8 +3880,7 @@ PP(pp_open_dir) { #if defined(Direntry_t) && defined(HAS_READDIR) dSP; - STRLEN n_a; - char *dirname = POPpx; + const char *dirname = POPpconstx; GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); @@ -3929,7 +3913,7 @@ PP(pp_readdir) dSP; SV *sv; - I32 gimme = GIMME; + const I32 gimme = GIMME; GV *gv = (GV *)POPs; register Direntry_t *dp; register IO *io = GvIOn(gv); @@ -3972,7 +3956,7 @@ nope: PP(pp_telldir) { #if defined(HAS_TELLDIR) || defined(telldir) - dSP; dTARGET; + dVAR; dSP; dTARGET; /* XXX does _anyone_ need this? --AD 2/20/1998 */ /* XXX netbsd still seemed to. XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style. @@ -4181,14 +4165,12 @@ PP(pp_system) { dSP; dMARK; dORIGMARK; dTARGET; I32 value; - STRLEN n_a; int result; - I32 did_pipes = 0; if (PL_tainting) { TAINT_ENV(); while (++MARK <= SP) { - (void)SvPV_nolen(*MARK); /* stringify for taint check */ + (void)SvPV_nolen_const(*MARK); /* stringify for taint check */ if (PL_tainted) break; } @@ -4200,6 +4182,7 @@ PP(pp_system) { Pid_t childpid; int pp[2]; + I32 did_pipes = 0; if (PerlProc_pipe(pp) >= 0) did_pipes = 1; @@ -4272,7 +4255,7 @@ PP(pp_system) else if (SP - MARK != 1) value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes); else { - value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes); + value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes); } PerlProc__exit(-1); } @@ -4281,21 +4264,21 @@ PP(pp_system) result = 0; if (PL_op->op_flags & OPf_STACKED) { SV *really = *++MARK; -# if defined(WIN32) || defined(OS2) +# if defined(WIN32) || defined(OS2) || defined(SYMBIAN) value = (I32)do_aspawn(really, MARK, SP); # else value = (I32)do_aspawn(really, (void **)MARK, (void **)SP); # endif } else if (SP - MARK != 1) { -# if defined(WIN32) || defined(OS2) +# if defined(WIN32) || defined(OS2) || defined(SYMBIAN) value = (I32)do_aspawn(Nullsv, MARK, SP); # else value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP); # endif } else { - value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a)); + value = (I32)do_spawn(SvPVx_nolen(sv_mortalcopy(*SP))); } if (PL_statusvalue == -1) /* hint that value must be returned as is */ result = 1; @@ -4311,12 +4294,11 @@ PP(pp_exec) { dSP; dMARK; dORIGMARK; dTARGET; I32 value; - STRLEN n_a; if (PL_tainting) { TAINT_ENV(); while (++MARK <= SP) { - (void)SvPV_nolen(*MARK); /* stringify for taint check */ + (void)SvPV_nolen_const(*MARK); /* stringify for taint check */ if (PL_tainted) break; } @@ -4343,13 +4325,13 @@ PP(pp_exec) #endif else { #ifdef VMS - value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a)); + value = (I32)vms_do_exec(SvPVx_nolen(sv_mortalcopy(*SP))); #else # ifdef __OPEN_VM - (void) do_spawn(SvPVx(sv_mortalcopy(*SP), n_a)); + (void) do_spawn(SvPVx_nolen(sv_mortalcopy(*SP))); value = 0; # else - value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a)); + value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP))); # endif #endif } @@ -4378,6 +4360,9 @@ PP(pp_getppid) #ifdef HAS_GETPPID dSP; dTARGET; # ifdef THREADS_HAVE_PIDS + if (PL_ppid != 1 && getppid() == 1) + /* maybe the parent process has died. Refresh ppid cache */ + PL_ppid = 1; XPUSHi( PL_ppid ); # else XPUSHi( getppid() ); @@ -4532,10 +4517,12 @@ PP(pp_gmtime) { dSP; Time_t when; - struct tm *tmbuf; - static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; - static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; + const struct tm *tmbuf; + static const char * const dayname[] = + {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; + static const char * const monname[] = + {"Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; if (MAXARG < 1) (void)time(&when); @@ -4771,7 +4758,6 @@ PP(pp_ghostent) #endif struct hostent *hent; unsigned long len; - STRLEN n_a; EXTEND(SP, 10); if (which == OP_GHBYNAME) { @@ -4887,7 +4873,6 @@ PP(pp_gnetent) struct netent *getnetent(void); #endif struct netent *nent; - STRLEN n_a; if (which == OP_GNBYNAME){ #ifdef HAS_GETNETBYNAME @@ -4988,7 +4973,6 @@ PP(pp_gprotoent) struct protoent *getprotoent(void); #endif struct protoent *pent; - STRLEN n_a; if (which == OP_GPBYNAME) { #ifdef HAS_GETPROTOBYNAME @@ -5075,7 +5059,6 @@ PP(pp_gservent) struct servent *getservent(void); #endif struct servent *sent; - STRLEN n_a; if (which == OP_GSBYNAME) { #ifdef HAS_GETSERVBYNAME @@ -5271,7 +5254,6 @@ PP(pp_gpwent) dSP; I32 which = PL_op->op_type; register SV *sv; - STRLEN n_a; struct passwd *pwent = NULL; /* * We currently support only the SysV getsp* shadow password interface. @@ -5550,7 +5532,6 @@ PP(pp_ggrent) register char **elem; register SV *sv; struct group *grent; - STRLEN n_a; if (which == OP_GGRNAM) { char* name = POPpbytex; @@ -5662,7 +5643,6 @@ PP(pp_syscall) unsigned long a[20]; register I32 i = 0; I32 retval = -1; - STRLEN n_a; if (PL_tainting) { while (++MARK <= SP) { @@ -5685,7 +5665,7 @@ PP(pp_syscall) else if (*MARK == &PL_sv_undef) a[i++] = 0; else - a[i++] = (unsigned long)SvPV_force(*MARK, n_a); + a[i++] = (unsigned long)SvPV_force_nolen(*MARK); if (i > 15) break; } @@ -5876,5 +5856,5 @@ lockf_emulate_flock(int fd, int operation) * indent-tabs-mode: t * End: * - * vim: shiftwidth=4: -*/ + * ex: set ts=8 sts=4 sw=4 noet: + */