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;
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)
mg_get(left); /* or mg_get(left) may happen here */
if (!SvOK(TARG))
sv_setpvn(left, "", 0);
- (void)SvPV_nomg(left, llen); /* Needed to set UTF8 flag */
+ (void)SvPV_nomg_const(left, llen); /* Needed to set UTF8 flag */
lbyte = !DO_UTF8(left);
if (IN_BYTES)
SvUTF8_off(TARG);
{
if (*relem) {
SV *tmpstr;
- HE *didstore;
+ const HE *didstore;
if (ckWARN(WARN_MISC)) {
const char *err;
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;
}
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");
}
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;
&& !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)
if (gimme == G_ARRAY) {
const I32 nparens = rx->nparens;
I32 i = (global && !nparens) ? 1 : 0;
- I32 len;
SPAGAIN; /* EVAL blocks could move the stack. */
EXTEND(SP, nparens + i);
PUSHs(sv_newmortal());
/*SUPPRESS 560*/
if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
- len = rx->endp[i] - rx->startp[i];
+ const I32 len = rx->endp[i] - rx->startp[i];
s = rx->startp[i] + truebase;
if (rx->endp[i] < 0 || rx->startp[i] < 0 ||
len < 0 || len > strend - s)
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);
}
if (PL_sawampersand) {
I32 off;
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) {
if (DEBUG_C_TEST) {
PerlIO_printf(Perl_debug_log,
(int)(t-truebase));
}
rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
- rx->subbeg = SvPVX(rx->saved_copy) + (t - truebase);
+ rx->subbeg = SvPVX_const(rx->saved_copy) + (t - truebase);
assert (SvPOKp(rx->saved_copy));
} else
#endif
{
rx->subbeg = savepvn(t, strend - t);
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
rx->saved_copy = Nullsv;
#endif
}
sv = TARG;
if (SvROK(sv))
sv_unref(sv);
- (void)SvUPGRADE(sv, SVt_PV);
+ SvUPGRADE(sv, SVt_PV);
tmplen = SvLEN(sv); /* remember if already alloced */
if (!tmplen && !SvREADONLY(sv))
Sv_Grow(sv, 80); /* try short-buffering it */
if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
tmps = SvEND(sv) - 1;
- if (*tmps == *SvPVX(PL_rs)) {
+ if (*tmps == *SvPVX_const(PL_rs)) {
*tmps = '\0';
SvCUR_set(sv, SvCUR(sv) - 1);
}
if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
break;
- if (*tmps && PerlLIO_lstat(SvPVX(sv), &PL_statbuf) < 0) {
+ if (*tmps && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
(void)POPs; /* Unmatched wildcard? Chuck it... */
continue;
}
const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
SV *sv;
-#ifdef PERL_COPY_ON_WRITE
- const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0;
-#else
- const U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
-#endif
+ const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvSHARED_HASH(keysv) : 0;
I32 preeminent = 0;
if (SvTYPE(hv) == SVt_PVHV) {
else {
if (!preeminent) {
STRLEN keylen;
- const char * const key = SvPV(keysv, keylen);
+ const char * const key = SvPV_const(keysv, keylen);
SAVEDELETE(hv, savepvn(key,keylen), keylen);
} else
save_helem(hv, keysv, svp);
/* string increment */
register SV* cur = cx->blk_loop.iterlval;
STRLEN maxlen = 0;
- const char *max = SvOK((SV*)av) ? SvPV((SV*)av, maxlen) : "";
+ const char *max = SvOK((SV*)av) ? SvPV_const((SV*)av, maxlen) : "";
if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
*itersvp = newSVsv(cur);
SvREFCNT_dec(oldsv);
}
- if (strEQ(SvPVX(cur), max))
+ if (strEQ(SvPVX_const(cur), max))
sv_setiv(cur, 0); /* terminate next time */
else
sv_inc(cur);
register char *s;
char *strend;
register char *m;
- char *c;
+ const char *c;
register char *d;
STRLEN clen;
I32 iters = 0;
I32 oldsave = PL_savestack_ix;
STRLEN slen;
bool doutf8 = FALSE;
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
bool is_cow;
#endif
SV *nsv = Nullsv;
EXTEND(SP,1);
}
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
/* Awooga. Awooga. "bool" types that are actually char are dangerous,
because they make integers such as 256 "false". */
is_cow = SvIsCOW(TARG) ? TRUE : FALSE;
sv_force_normal_flags(TARG,0);
#endif
if (
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
!is_cow &&
#endif
(SvREADONLY(TARG)
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);
}
}
/* can do inplace substitution? */
if (c
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
&& !is_cow
#endif
&& (I32)clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
LEAVE_SCOPE(oldsave);
RETURN;
}
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(TARG)) {
assert (!force_on_match);
goto have_a_cow;
REXEC_NOT_FIRST|REXEC_IGNOREPOS));
if (s != d) {
i = strend - s;
- SvCUR_set(TARG, d - SvPVX(TARG) + i);
+ SvCUR_set(TARG, d - SvPVX_const(TARG) + i);
Move(s, d, i+1, char); /* include the NUL */
}
TAINT_IF(rxtainted & 1);
s = SvPV_force(TARG, len);
goto force_it;
}
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
have_a_cow:
#endif
rxtainted |= RX_MATCH_TAINTED(rx);
else
sv_catpvn(dstr, s, strend - s);
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
/* The match may make the string COW. If so, brilliant, because that's
just saved us one malloc, copy and free - the regexp has donated
the old buffer, and we malloc an entirely new one, rather than the
mg_get(sv);
if (SvROK(sv))
goto got_rv;
- sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
+ sym = SvPOKp(sv) ? SvPVX_const(sv) : Nullch;
}
else {
STRLEN n_a;
{
dSP;
SV* sv = cSVOP_sv;
- U32 hash = SvUVX(sv);
+ U32 hash = SvSHARED_HASH(sv);
XPUSHs(method_common(sv, &hash));
RETURN;
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);
/* this isn't a reference */
packname = Nullch;
- if(SvOK(sv) && (packname = SvPV(sv, packlen))) {
- HE* he;
- he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
+ 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)));
goto fetch;
/* shortcut for simple names */
if (hashp) {
- HE* he = hv_fetch_ent(stash, meth, 0, *hashp);
+ const HE* const he = hv_fetch_ent(stash, meth, 0, *hashp);
if (he) {
gv = (GV*)HeVAL(he);
if (isGV(gv) && GvCV(gv) &&
sep = p, leaf = p + 2;
}
if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
- /* the method name is unqualified or starts with SUPER:: */
- packname = sep ? CopSTASHPV(PL_curcop) :
- stash ? HvNAME_get(stash) : packname;
- if (!packname)
+ /* the method name is unqualified or starts with SUPER:: */
+ bool need_strlen = 1;
+ if (sep) {
+ packname = CopSTASHPV(PL_curcop);
+ }
+ else if (stash) {
+ HEK *packhek = HvNAME_HEK(stash);
+ if (packhek) {
+ packname = HEK_KEY(packhek);
+ packlen = HEK_LEN(packhek);
+ need_strlen = 0;
+ } else {
+ goto croak;
+ }
+ }
+
+ if (!packname) {
+ croak:
Perl_croak(aTHX_
"Can't use anonymous symbol table for method lookup");
- else
+ }
+ else if (need_strlen)
packlen = strlen(packname);
+
}
else {
/* the method name is qualified */
projects / p5sagit/p5-mst-13.2.git / blobdiff