diff options
| -rw-r--r-- | doio.c | 10 | ||||
| -rw-r--r-- | doop.c | 6 | ||||
| -rw-r--r-- | gv.c | 4 | ||||
| -rw-r--r-- | hv.c | 4 | ||||
| -rw-r--r-- | op.c | 70 | ||||
| -rw-r--r-- | pp.c | 18 | ||||
| -rw-r--r-- | pp_ctl.c | 10 | ||||
| -rw-r--r-- | pp_hot.c | 34 | ||||
| -rw-r--r-- | pp_pack.c | 6 | ||||
| -rw-r--r-- | pp_sys.c | 28 |
10 files changed, 108 insertions, 82 deletions
@@ -1345,7 +1345,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) Perl_warner(aTHX_ packWARN(WARN_UTF8), "Wide character in print"); } } - tmps = SvPV(sv, len); + tmps = SvPV_const(sv, len); break; } /* To detect whether the process is about to overstep its @@ -1404,7 +1404,7 @@ Perl_my_stat(pTHX) goto do_fstat; } - s = SvPV(sv, len); + s = SvPV_const(sv, len); PL_statgv = Nullgv; sv_setpvn(PL_statname, s, len); s = SvPVX_const(PL_statname); /* s now NUL-terminated */ @@ -1672,7 +1672,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) register I32 val; register I32 tot = 0; const char *what; - char *s; + const char *s; SV **oldmark = mark; STRLEN n_a; @@ -1738,7 +1738,7 @@ nothing in the core. APPLY_TAINT_PROPER(); if (mark == sp) break; - s = SvPVx(*++mark, n_a); + s = SvPVx_const(*++mark, n_a); if (isALPHA(*s)) { if (*s == 'S' && s[1] == 'I' && s[2] == 'G') s += 3; @@ -1808,7 +1808,7 @@ nothing in the core. APPLY_TAINT_PROPER(); tot = sp - mark; while (++mark <= sp) { - s = SvPVx(*mark, n_a); + s = SvPVx_const(*mark, n_a); APPLY_TAINT_PROPER(); if (PL_euid || PL_unsafe) { if (UNLINK(s)) @@ -648,7 +648,7 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s register STRLEN len; STRLEN delimlen; - (void) SvPV(del, delimlen); /* stringify and get the delimlen */ + (void) SvPV_const(del, delimlen); /* stringify and get the delimlen */ /* SvCUR assumes it's SvPOK() and woe betide you if it's not. */ mark++; @@ -658,7 +658,7 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s while (items-- > 0) { if (*mark && !SvGAMAGIC(*mark) && SvOK(*mark)) { STRLEN tmplen; - SvPV(*mark, tmplen); + SvPV_const(*mark, tmplen); len += tmplen; } mark++; @@ -700,7 +700,7 @@ void Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg) { STRLEN patlen; - const char *pat = SvPV(*sarg, patlen); + const char *pat = SvPV_const(*sarg, patlen); bool do_taint = FALSE; SvUTF8_off(sv); @@ -650,7 +650,7 @@ HV* Perl_gv_stashsv(pTHX_ SV *sv, I32 create) { STRLEN len; - const char *ptr = SvPV(sv,len); + const char *ptr = SvPV_const(sv,len); return gv_stashpvn(ptr, len, create); } @@ -663,7 +663,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) { GV * Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type) { STRLEN len; - const char *nambeg = SvPV(name, len); + const char *nambeg = SvPV_const(name, len); return gv_fetchpvn_flags(nambeg, len, flags | SvUTF8(name), sv_type); } @@ -426,7 +426,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (keysv) { if (flags & HVhek_FREEKEY) Safefree(key); - key = SvPV(keysv, klen); + key = SvPV_const(keysv, klen); flags = 0; is_utf8 = (SvUTF8(keysv) != 0); } else { @@ -942,7 +942,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (keysv) { if (k_flags & HVhek_FREEKEY) Safefree(key); - key = SvPV(keysv, klen); + key = SvPV_const(keysv, klen); k_flags = 0; is_utf8 = (SvUTF8(keysv) != 0); } else { @@ -2384,8 +2384,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) SV *rstr = ((SVOP*)repl)->op_sv; STRLEN tlen; STRLEN rlen; - U8 *t = (U8*)SvPV(tstr, tlen); - U8 *r = (U8*)SvPV(rstr, rlen); + const U8 *t = (U8*)SvPV_const(tstr, tlen); + const U8 *r = (U8*)SvPV_const(rstr, rlen); register I32 i; register I32 j; I32 del; @@ -2408,8 +2408,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) { SV* listsv = newSVpvn("# comment\n",10); SV* transv = 0; - U8* tend = t + tlen; - U8* rend = r + rlen; + const U8* tend = t + tlen; + const U8* rend = r + rlen; STRLEN ulen; UV tfirst = 1; UV tlast = 0; @@ -2430,12 +2430,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) if (!from_utf) { STRLEN len = tlen; - tsave = t = bytes_to_utf8(t, &len); + t = tsave = bytes_to_utf8(t, &len); tend = t + len; } if (!to_utf && rlen) { STRLEN len = rlen; - rsave = r = bytes_to_utf8(r, &len); + r = rsave = bytes_to_utf8(r, &len); rend = r + len; } @@ -2792,15 +2792,31 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg) if (expr->op_type == OP_CONST) { STRLEN plen; SV *pat = ((SVOP*)expr)->op_sv; - char *p = SvPV(pat, plen); + const char *p = SvPV_const(pat, plen); if ((o->op_flags & OPf_SPECIAL) && (*p == ' ' && p[1] == '\0')) { + U32 was_readonly = SvREADONLY(pat); + + if (was_readonly) { + if (SvFAKE(pat)) { + sv_force_normal_flags(pat, 0); + assert(!SvREADONLY(pat)); + was_readonly = 0; + } else { + SvREADONLY_off(pat); + } + } + sv_setpvn(pat, "\\s+", 3); - p = SvPV(pat, plen); + + SvFLAGS(pat) |= was_readonly; + + p = SvPV_const(pat, plen); pm->op_pmflags |= PMf_SKIPWHITE; } if (DO_UTF8(pat)) pm->op_pmdynflags |= PMdf_UTF8; - PM_SETRE(pm, CALLREGCOMP(aTHX_ p, p + plen, pm)); + /* FIXME - can we make this function take const char * args? */ + PM_SETRE(pm, CALLREGCOMP(aTHX_ (char*)p, (char*)p + plen, pm)); if (strEQ("\\s+", PM_GETRE(pm)->precomp)) pm->op_pmflags |= PMf_WHITE; op_free(expr); @@ -2996,7 +3012,7 @@ Perl_package(pTHX_ OP *o) save_hptr(&PL_curstash); save_item(PL_curstname); - name = SvPV(cSVOPo->op_sv, len); + name = SvPV_const(cSVOPo->op_sv, len); PL_curstash = gv_stashpvn(name, len, TRUE); sv_setpvn(PL_curstname, name, len); op_free(o); @@ -4009,7 +4025,7 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label) o = newOP(type, OPf_SPECIAL); else { o = newPVOP(type, 0, savepv(label->op_type == OP_CONST - ? SvPVx(((SVOP*)label)->op_sv, n_a) + ? SvPVx_const(((SVOP*)label)->op_sv, n_a) : "")); } op_free(label); @@ -4235,16 +4251,16 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) STRLEN n_a; const char *aname; GV *gv; - char *ps; + const char *ps; STRLEN ps_len; register CV *cv=0; SV *const_sv; - const char * const name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch; + const char * const name = o ? SvPVx_const(cSVOPo->op_sv, n_a) : Nullch; if (proto) { assert(proto->op_type == OP_CONST); - ps = SvPVx(((SVOP*)proto)->op_sv, ps_len); + ps = SvPVx_const(((SVOP*)proto)->op_sv, ps_len); } else ps = Nullch; @@ -5918,21 +5934,29 @@ Perl_ck_require(pTHX_ OP *o) SVOP *kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { + SV *sv = kid->op_sv; + U32 was_readonly = SvREADONLY(sv); char *s; - for (s = SvPVX(kid->op_sv); *s; s++) { + + if (was_readonly) { + if (SvFAKE(sv)) { + sv_force_normal_flags(sv, 0); + assert(!SvREADONLY(sv)); + was_readonly = 0; + } else { + SvREADONLY_off(sv); + } + } + + for (s = SvPVX(sv); *s; s++) { if (*s == ':' && s[1] == ':') { *s = '/'; Move(s+2, s+1, strlen(s+2)+1, char); - SvCUR_set(kid->op_sv, SvCUR(kid->op_sv) - 1); + SvCUR_set(sv, SvCUR(sv) - 1); } } - if (SvREADONLY(kid->op_sv)) { - SvREADONLY_off(kid->op_sv); - sv_catpvn(kid->op_sv, ".pm", 3); - SvREADONLY_on(kid->op_sv); - } - else - sv_catpvn(kid->op_sv, ".pm", 3); + sv_catpvn(sv, ".pm", 3); + SvFLAGS(sv) |= was_readonly; } } @@ -535,7 +535,7 @@ PP(pp_bless) if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv)) Perl_croak(aTHX_ "Attempt to bless into a reference"); - ptr = SvPV(ssv,len); + ptr = SvPV_const(ssv,len); if (ckWARN(WARN_MISC) && len == 0) Perl_warner(aTHX_ packWARN(WARN_MISC), "Explicit blessing to '' (assuming package main)"); @@ -2906,14 +2906,14 @@ PP(pp_abs) PP(pp_hex) { dSP; dTARGET; - char *tmps; + const char *tmps; I32 flags = PERL_SCAN_ALLOW_UNDERSCORES; STRLEN len; NV result_nv; UV result_uv; SV* sv = POPs; - tmps = (SvPVx(sv, len)); + tmps = (SvPVx_const(sv, len)); if (DO_UTF8(sv)) { /* If Unicode, try to downgrade * If not possible, croak. */ @@ -2936,14 +2936,14 @@ PP(pp_hex) PP(pp_oct) { dSP; dTARGET; - char *tmps; + const char *tmps; I32 flags = PERL_SCAN_ALLOW_UNDERSCORES; STRLEN len; NV result_nv; UV result_uv; SV* sv = POPs; - tmps = (SvPVx(sv, len)); + tmps = (SvPVx_const(sv, len)); if (DO_UTF8(sv)) { /* If Unicode, try to downgrade * If not possible, croak. */ @@ -3028,7 +3028,7 @@ PP(pp_substr) else if (DO_UTF8(sv)) repl_need_utf8_upgrade = TRUE; } - tmps = SvPV(sv, curlen); + tmps = SvPV_const(sv, curlen); if (DO_UTF8(sv)) { utf8_curlen = sv_len_utf8(sv); if (utf8_curlen == curlen) @@ -3336,7 +3336,7 @@ PP(pp_ord) dSP; dTARGET; SV *argsv = POPs; STRLEN len; - U8 *s = (U8*)SvPVx(argsv, len); + const U8 *s = (U8*)SvPVx_const(argsv, len); SV *tmpsv; if (PL_encoding && SvPOK(argsv) && !DO_UTF8(argsv)) { @@ -3767,7 +3767,7 @@ PP(pp_quotemeta) dSP; dTARGET; SV *sv = TOPs; STRLEN len; - register char *s = SvPV(sv,len); + const register char *s = SvPV_const(sv,len); register char *d; SvUTF8_off(TARG); /* decontaminate */ @@ -4042,7 +4042,7 @@ PP(pp_hslice) save_helem(hv, keysv, svp); else { STRLEN keylen; - char *key = SvPV(keysv, keylen); + const char *key = SvPV_const(keysv, keylen); SAVEDELETE(hv, savepvn(key,keylen), keylen); } } @@ -3054,9 +3054,9 @@ PP(pp_require) dVAR; dSP; register PERL_CONTEXT *cx; SV *sv; - char *name; + const char *name; STRLEN len; - char *tryname = Nullch; + const char *tryname = Nullch; SV *namesv = Nullsv; SV** svp; const I32 gimme = GIMME_V; @@ -3084,7 +3084,7 @@ PP(pp_require) RETPUSHYES; } - name = SvPV(sv, len); + name = SvPV_const(sv, len); if (!(name && len > 0 && *name)) DIE(aTHX_ "Null filename used"); TAINT_PROPER("require"); @@ -3296,7 +3296,7 @@ PP(pp_require) SvREFCNT_dec(namesv); if (!tryrsfp) { if (PL_op->op_type == OP_REQUIRE) { - char *msgstr = name; + const char *msgstr = name; if (namesv) { /* did we lookup @INC? */ SV *msg = sv_2mortal(newSVpv(msgstr,0)); SV *dirmsgsv = NEWSV(0, 0); @@ -3406,7 +3406,7 @@ PP(pp_entereval) CV* runcv; U32 seq; - if (!SvPV(sv,len)) + if (!SvPV_const(sv,len)) RETPUSHUNDEF; TAINT_PROPER("eval"); @@ -147,7 +147,7 @@ PP(pp_concat) dPOPTOPssrl; bool lbyte; STRLEN rlen; - const char *rpv = SvPV(right, rlen); /* mg_get(right) happens here */ + const char *rpv = SvPV_const(right, rlen); /* mg_get(right) happens here */ const bool rbyte = !DO_UTF8(right); bool rcopied = FALSE; @@ -159,7 +159,7 @@ PP(pp_concat) if (TARG != left) { STRLEN llen; - const char* const lpv = SvPV(left, llen); /* mg_get(left) may happen here */ + const char* const lpv = SvPV_const(left, llen); /* mg_get(left) may happen here */ lbyte = !DO_UTF8(left); sv_setpvn(TARG, lpv, llen); if (!lbyte) @@ -1176,12 +1176,12 @@ PP(pp_match) dSP; dTARG; register PMOP *pm = cPMOP; PMOP *dynpm = pm; - register char *t; - register char *s; - char *strend; + const register char *t; + const register char *s; + const char *strend; I32 global; I32 r_flags = REXEC_CHECKED; - char *truebase; /* Start of string */ + const char *truebase; /* Start of string */ register REGEXP *rx = PM_GETRE(pm); bool rxtainted; const I32 gimme = GIMME; @@ -1201,7 +1201,7 @@ PP(pp_match) } PUTBACK; /* EVAL blocks need stack_sp. */ - s = SvPV(TARG, len); + s = SvPV_const(TARG, len); strend = s + len; if (!s) DIE(aTHX_ "panic: pp_match"); @@ -1263,8 +1263,9 @@ play_it_again: } if (rx->reganch & RE_USE_INTUIT && DO_UTF8(TARG) == ((rx->reganch & ROPT_UTF8) != 0)) { - PL_bostr = truebase; - s = CALLREG_INTUIT_START(aTHX_ rx, TARG, s, strend, r_flags, NULL); + /* FIXME - can PL_bostr be made const char *? */ + PL_bostr = (char *)truebase; + s = CALLREG_INTUIT_START(aTHX_ rx, TARG, (char *)s, (char *)strend, r_flags, NULL); if (!s) goto nope; @@ -1276,7 +1277,7 @@ play_it_again: && !SvROK(TARG)) /* Cannot trust since INTUIT cannot guess ^ */ goto yup; } - if (CALLREGEXEC(aTHX_ rx, s, strend, truebase, minmatch, TARG, NULL, r_flags)) + if (CALLREGEXEC(aTHX_ rx, (char*)s, (char *)strend, (char*)truebase, minmatch, TARG, NULL, r_flags)) { PL_curpm = pm; if (dynpm->op_pmflags & PMf_ONCE) @@ -1373,7 +1374,8 @@ yup: /* Confirmed by INTUIT */ RX_MATCH_COPIED_off(rx); rx->subbeg = Nullch; if (global) { - rx->subbeg = truebase; + /* FIXME - should rx->subbeg be const char *? */ + rx->subbeg = (char *) truebase; rx->startp[0] = s - truebase; if (RX_MATCH_UTF8(rx)) { char *t = (char*)utf8_hop((U8*)s, rx->minlen); @@ -1940,7 +1942,7 @@ PP(pp_subst) register char *s; char *strend; register char *m; - char *c; + const char *c; register char *d; STRLEN clen; I32 iters = 0; @@ -2050,11 +2052,11 @@ PP(pp_subst) sv_recode_to_utf8(nsv, PL_encoding); else sv_utf8_upgrade(nsv); - c = SvPV(nsv, clen); + c = SvPV_const(nsv, clen); doutf8 = TRUE; } else { - c = SvPV(dstr, clen); + c = SvPV_const(dstr, clen); doutf8 = DO_UTF8(dstr); } } @@ -2977,7 +2979,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) const char* packname = 0; SV *packsv = Nullsv; STRLEN packlen; - const char *name = SvPV(meth, namelen); + const char *name = SvPV_const(meth, namelen); sv = *(PL_stack_base + TOPMARK + 1); @@ -2994,7 +2996,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) /* this isn't a reference */ packname = Nullch; - if(SvOK(sv) && (packname = SvPV(sv, packlen))) { + if(SvOK(sv) && (packname = SvPV_const(sv, packlen))) { const HE* const he = hv_fetch_ent(PL_stashcache, sv, 0, 0); if (he) { stash = INT2PTR(HV*,SvIV(HeVAL(he))); @@ -2275,8 +2275,8 @@ PP(pp_unpack) I32 gimme = GIMME_V; STRLEN llen; STRLEN rlen; - const char *pat = SvPV(left, llen); - const char *s = SvPV(right, rlen); + const char *pat = SvPV_const(left, llen); + const char *s = SvPV_const(right, rlen); const char *strend = s + rlen; const char *patend = pat + llen; I32 cnt; @@ -3603,7 +3603,7 @@ PP(pp_pack) dSP; dMARK; dORIGMARK; dTARGET; register SV *cat = TARG; STRLEN fromlen; - register const char *pat = SvPVx(*++MARK, fromlen); + register const char *pat = SvPVx_const(*++MARK, fromlen); register const char *patend = pat + fromlen; MARK++; @@ -322,7 +322,7 @@ PP(pp_backtick) dSP; dTARGET; PerlIO *fp; STRLEN n_a; - char *tmps = POPpx; + const char *tmps = POPpconstx; const I32 gimme = GIMME_V; const char *mode = "r"; @@ -331,7 +331,7 @@ PP(pp_backtick) mode = "rb"; else if (PL_op->op_private & OPpOPEN_IN_CRLF) mode = "rt"; - fp = PerlProc_popen(tmps, (char *)mode); + fp = PerlProc_popen((char*)tmps, (char *)mode); if (fp) { const char *type = NULL; if (PL_curcop->cop_io) { @@ -476,13 +476,13 @@ 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; @@ -532,7 +532,7 @@ PP(pp_open) GV *gv; SV *sv; IO *io; - char *tmps; + const char *tmps; STRLEN len; MAGIC *mg; bool ok; @@ -563,8 +563,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 ); @@ -2840,7 +2840,7 @@ 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_const(sv,n_a)); PL_statgv = Nullgv; PL_laststype = PL_op->op_type; if (PL_op->op_type == OP_LSTAT) @@ -3546,12 +3546,12 @@ 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; @@ -3565,7 +3565,7 @@ PP(pp_chdir) { if( MAXARG == 1 ) deprecate("chdir('') or chdir(undef) as chdir()"); - tmps = SvPV(*svp, n_a); + tmps = SvPV_const(*svp, n_a); } else { PUSHi(0); @@ -3823,7 +3823,7 @@ S_dooneliner(pTHX_ const char *cmd, const 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)--; \ @@ -3840,7 +3840,7 @@ PP(pp_mkdir) int oldumask; #endif STRLEN len; - char *tmps; + const char *tmps; bool copy = FALSE; if (MAXARG > 1) @@ -3868,7 +3868,7 @@ PP(pp_rmdir) { dSP; dTARGET; STRLEN len; - char *tmps; + const char *tmps; bool copy = FALSE; TRIMSLASHES(tmps,len,copy); |