#define RETURN_UNLIMITED_NUMBER (PERL_INT_MAX / 2)
-STATIC char*
+STATIC const char*
S_gv_ename(pTHX_ GV *gv)
{
- STRLEN n_a;
SV* tmpsv = sv_newmortal();
gv_efullname3(tmpsv, gv, Nullch);
- return SvPV(tmpsv,n_a);
+ return SvPV_nolen_const(tmpsv);
}
STATIC OP *
dup_attrlist(attrs)));
/* Fake up a method call to import */
- meth = newSVpvn("import", 6);
- SvUPGRADE(meth, SVt_PVIV);
- (void)SvIOK_on(meth);
- {
- U32 hash;
- PERL_HASH(hash, SvPVX_const(meth), SvCUR(meth));
- SvUV_set(meth, hash);
- }
+ meth = newSVpvn_share("import", 6, 0);
imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL|OPf_WANT_VOID,
append_elem(OP_LIST,
prepend_elem(OP_LIST, pack, list(arg)),
t = uvuni_to_utf8_flags(tmpbuf, 0x7fffffff,
UNICODE_ALLOW_SUPER);
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
- t = (U8*)SvPVX(transv);
+ t = (const U8*)SvPVX_const(transv);
tlen = SvCUR(transv);
tend = t + tlen;
Safefree(cp);
pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
/* Fake up a method call to VERSION */
- meth = newSVpvn("VERSION",7);
- sv_upgrade(meth, SVt_PVIV);
- (void)SvIOK_on(meth);
- {
- U32 hash;
- PERL_HASH(hash, SvPVX_const(meth), SvCUR(meth));
- SvUV_set(meth, hash);
- }
+ meth = newSVpvn_share("VERSION", 7, 0);
veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
append_elem(OP_LIST,
prepend_elem(OP_LIST, pack, list(version)),
pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
/* Fake up a method call to import/unimport */
- meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);
- SvUPGRADE(meth, SVt_PVIV);
- (void)SvIOK_on(meth);
- {
- U32 hash;
- PERL_HASH(hash, SvPVX_const(meth), SvCUR(meth));
- SvUV_set(meth, hash);
- }
+ meth = aver
+ ? newSVpvn_share("import",6, 0) : newSVpvn_share("unimport", 8, 0);
imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
append_elem(OP_LIST,
prepend_elem(OP_LIST, pack, list(arg)),
/* Fake up the BEGIN {}, which does its thing immediately. */
newATTRSUB(floor,
- newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
+ newSVOP(OP_CONST, 0, newSVpvn_share("BEGIN", 5, 0)),
Nullop,
Nullop,
append_elem(OP_LINESEQ,
}
OP *
-Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
+Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP *block, OP *cont)
{
dVAR;
LOOP *loop;
*/
UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
LOGOP* range = (LOGOP*) flip->op_first;
- OP* left = range->op_first;
- OP* right = left->op_sibling;
+ OP* const left = range->op_first;
+ OP* const right = left->op_sibling;
LISTOP* listop;
range->op_flags &= ~OPf_KIDS;
Perl_newLOOPEX(pTHX_ I32 type, OP *label)
{
OP *o;
- STRLEN n_a;
if (type != OP_GOTO || label->op_type == OP_CONST) {
/* "last()" means "last" */
o = newOP(type, OPf_SPECIAL);
else {
o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
- ? SvPVx_const(((SVOP*)label)->op_sv, n_a)
+ ? SvPVx_nolen_const(((SVOP*)label)->op_sv)
: ""));
}
op_free(label);
Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
{
dVAR;
- STRLEN n_a;
const char *aname;
GV *gv;
const char *ps;
STRLEN ps_len;
register CV *cv=0;
SV *const_sv;
+ I32 gv_fetch_flags;
- const char * const name = o ? SvPVx_const(cSVOPo->op_sv, n_a) : Nullch;
+ const char * const name = o ? SvPVx_nolen_const(cSVOPo->op_sv) : Nullch;
if (proto) {
assert(proto->op_type == OP_CONST);
}
else
aname = Nullch;
- gv = name ? gv_fetchsv(cSVOPo->op_sv,
- GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
- SVt_PVCV)
+
+ gv_fetch_flags = (block || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS))
+ ? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;
+ gv = name ? gv_fetchsv(cSVOPo->op_sv, gv_fetch_flags, SVt_PVCV)
: gv_fetchpv(aname ? aname
: (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
- GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT),
- SVt_PVCV);
+ gv_fetch_flags, SVt_PVCV);
if (o)
SAVEFREEOP(o);
}
#endif
- if (!block || !ps || *ps || attrs)
+ if (!block || !ps || *ps || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS))
const_sv = Nullsv;
else
const_sv = op_const_sv(block, Nullcv);
if (GvCVGEN(gv)) {
/* just a cached method */
SvREFCNT_dec(cv);
- cv = 0;
+ cv = Nullcv;
}
else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
/* already defined (or promised) */
/* XXX It's possible for this HvNAME_get to return null, and get passed into strEQ */
- if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
- && strEQ(HvNAME_get(GvSTASH(CvGV(cv))), "autouse"))) {
- const line_t oldline = CopLINE(PL_curcop);
- if (PL_copline != NOLINE)
- CopLINE_set(PL_curcop, PL_copline);
- Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
- CvCONST(cv) ? "Constant subroutine %s redefined"
- : "Subroutine %s redefined"
- ,name);
- CopLINE_set(PL_curcop, oldline);
+ if (ckWARN(WARN_REDEFINE)) {
+ GV * const gvcv = CvGV(cv);
+ if (gvcv) {
+ HV * const stash = GvSTASH(gvcv);
+ if (stash) {
+ const char *name = HvNAME_get(stash);
+ if ( strEQ(name,"autouse") ) {
+ const line_t oldline = CopLINE(PL_curcop);
+ if (PL_copline != NOLINE)
+ CopLINE_set(PL_curcop, PL_copline);
+ Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+ CvCONST(cv) ? "Constant subroutine %s redefined"
+ : "Subroutine %s redefined"
+ ,name);
+ CopLINE_set(PL_curcop, oldline);
+ }
+ }
+ }
}
SvREFCNT_dec(cv);
- cv = 0;
+ cv = Nullcv;
}
}
}
if (tmpstr) {
- name = SvPV(tmpstr, len);
+ name = SvPV_const(tmpstr, len);
sv_2mortal(tmpstr);
}
}
I32 arg = 0;
I32 contextclass = 0;
char *e = 0;
- STRLEN n_a;
bool delete_op = 0;
o->op_private |= OPpENTERSUB_HASTARG;
else {
if (SvPOK(cv)) {
namegv = CvANON(cv) ? gv : CvGV(cv);
- proto = SvPV((SV*)cv, n_a);
+ proto = SvPV_nolen((SV*)cv);
}
if (CvASSERTION(cv)) {
if (PL_hints & HINT_ASSERTING) {
SV *lexname;
GV **fields;
SV **svp, *sv;
- char *key = NULL;
+ const char *key = NULL;
STRLEN keylen;
o->op_opt = 1;
/* Make the CONST have a shared SV */
svp = cSVOPx_svp(((BINOP*)o)->op_last);
if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) {
- key = SvPV(sv, keylen);
+ key = SvPV_const(sv, keylen);
lexname = newSVpvn_share(key,
SvUTF8(sv) ? -(I32)keylen : keylen,
0);
fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
if (!fields || !GvHV(*fields))
break;
- key = SvPV(*svp, keylen);
+ key = SvPV_const(*svp, keylen);
if (!hv_fetch(GvHV(*fields), key,
SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
{
Perl_croak(aTHX_ "No such class field \"%s\" "
"in variable %s of type %s",
- key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname)));
+ key, SvPV_nolen_const(lexname), HvNAME_get(SvSTASH(lexname)));
}
break;
SV *lexname;
GV **fields;
SV **svp;
- char *key;
+ const char *key;
STRLEN keylen;
SVOP *first_key_op, *key_op;
if (key_op->op_type != OP_CONST)
continue;
svp = cSVOPx_svp(key_op);
- key = SvPV(*svp, keylen);
+ key = SvPV_const(*svp, keylen);
if (!hv_fetch(GvHV(*fields), key,
SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
{
projects / p5sagit/p5-mst-13.2.git / blobdiff