void
Perl_Slab_Free(pTHX_ void *op)
{
- I32 **ptr = (I32 **) op;
- I32 *slab = ptr[-1];
+ I32 ** const ptr = (I32 **) op;
+ I32 * const slab = ptr[-1];
assert( ptr-1 > (I32 **) slab );
assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
assert( *slab > 0 );
STATIC const char*
S_gv_ename(pTHX_ GV *gv)
{
- SV* tmpsv = sv_newmortal();
+ SV* const tmpsv = sv_newmortal();
gv_efullname3(tmpsv, gv, Nullch);
return SvPV_nolen_const(tmpsv);
}
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)),
while (len) {
for (; isSPACE(*attrstr) && len; --len, ++attrstr) ;
if (len) {
- const char *sstr = attrstr;
+ const char * const sstr = attrstr;
for (; !isSPACE(*attrstr) && len; --len, ++attrstr) ;
attrs = append_elem(OP_LIST, attrs,
newSVOP(OP_CONST, 0,
OP *o;
bool ismatchop = 0;
- if (ckWARN(WARN_MISC) &&
- (left->op_type == OP_RV2AV ||
+ if ( (left->op_type == OP_RV2AV ||
left->op_type == OP_RV2HV ||
left->op_type == OP_PADAV ||
- left->op_type == OP_PADHV)) {
+ left->op_type == OP_PADHV)
+ && ckWARN(WARN_MISC))
+ {
const char *desc = PL_op_desc[(right->op_type == OP_SUBST ||
right->op_type == OP_TRANS)
? right->op_type : OP_MATCH];
;
#endif
else {
- if (ckWARN(WARN_PARENTHESIS)
- && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
+ if ( PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ','
+ && ckWARN(WARN_PARENTHESIS))
{
char *s = PL_bufptr;
bool sigil = FALSE;
U8 tmpbuf[UTF8_MAXBYTES+1];
UV *cp;
UV nextmin = 0;
- New(1109, cp, 2*tlen, UV);
+ Newx(cp, 2*tlen, UV);
i = 0;
transv = newSVpvn("",0);
while (t < tend) {
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);
veop = Nullop;
- if (version != Nullop) {
+ if (version) {
SV *vesv = ((SVOP*)version)->op_sv;
- if (arg == Nullop && !SvNIOKp(vesv)) {
+ if (!arg && !SvNIOKp(vesv)) {
arg = version;
}
else {
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 *curop;
PL_modcount = 0;
- PL_eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
+ /* Grandfathering $[ assignment here. Bletch.*/
+ /* Only simple assignments like C<< ($[) = 1 >> are allowed */
+ PL_eval_start = (left->op_type == OP_CONST) ? right : 0;
left = mod(left, OP_AASSIGN);
if (PL_eval_start)
PL_eval_start = 0;
- else {
- op_free(left);
- op_free(right);
- return Nullop;
+ else if (left->op_type == OP_CONST) {
+ /* Result of assignment is always 1 (or we'd be dead already) */
+ return newSVOP(OP_CONST, 0, newSViv(1));
}
/* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */
if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV)
if (PL_eval_start)
PL_eval_start = 0;
else {
- op_free(o);
- return Nullop;
+ o = newSVOP(OP_CONST, 0, newSViv(PL_compiling.cop_arybase));
}
}
return o;
if (first->op_type == OP_CONST) {
if (first->op_private & OPpCONST_STRICT)
no_bareword_allowed(first);
- else if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
+ else if ((first->op_private & OPpCONST_BARE) && ckWARN(WARN_BAREWORD))
Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
if ((type == OP_AND && SvTRUE(((SVOP*)first)->op_sv)) ||
(type == OP_OR && !SvTRUE(((SVOP*)first)->op_sv)) ||
return first;
}
}
- else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS) &&
- type != OP_DOR) /* [#24076] Don't warn for <FH> err FOO. */
+ else if ((first->op_flags & OPf_KIDS) && type != OP_DOR
+ && ckWARN(WARN_MISC)) /* [#24076] Don't warn for <FH> err FOO. */
{
const OP *k1 = ((UNOP*)first)->op_first;
const OP *k2 = k1->op_sibling;
OP* o;
const bool once = block && block->op_flags & OPf_SPECIAL &&
(block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
- (void)debuggable;
+
+ PERL_UNUSED_ARG(debuggable);
if (expr) {
if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
expr = newUNOP(OP_DEFINED, 0,
newASSIGNOP(0, newDEFSVOP(), 0, expr) );
} else if (expr->op_flags & OPf_KIDS) {
- const OP *k1 = ((UNOP*)expr)->op_first;
- const OP *k2 = (k1) ? k1->op_sibling : NULL;
+ const OP * const k1 = ((UNOP*)expr)->op_first;
+ const OP * const k2 = k1 ? k1->op_sibling : NULL;
switch (expr->op_type) {
case OP_NULL:
if (k2 && k2->op_type == OP_READLINE
OP *listop;
OP *o;
U8 loopflags = 0;
- (void)debuggable;
+
+ PERL_UNUSED_ARG(debuggable);
if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
expr = newUNOP(OP_DEFINED, 0,
newASSIGNOP(0, newDEFSVOP(), 0, expr) );
} else if (expr && (expr->op_flags & OPf_KIDS)) {
- const OP *k1 = ((UNOP*)expr)->op_first;
- const OP *k2 = (k1) ? k1->op_sibling : NULL;
+ const OP * const k1 = ((UNOP*)expr)->op_first;
+ const OP * const k2 = (k1) ? k1->op_sibling : NULL;
switch (expr->op_type) {
case OP_NULL:
if (k2 && k2->op_type == OP_READLINE
o = cLISTOPo->op_first->op_sibling;
for (; o; o = o->op_next) {
- OPCODE type = o->op_type;
+ const OPCODE type = o->op_type;
if (sv && o->op_next == o)
return sv;
void
Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
{
- (void)floor;
+ PERL_UNUSED_ARG(floor);
+
if (o)
SAVEFREEOP(o);
if (proto)
STRLEN ps_len;
register CV *cv=0;
SV *const_sv;
+ I32 gv_fetch_flags;
const char * const name = o ? SvPVx_nolen_const(cSVOPo->op_sv) : Nullch;
ps = Nullch;
if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) {
- SV *sv = sv_newmortal();
+ SV * const sv = sv_newmortal();
Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]",
PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
}
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);
CV *
Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
{
- GV *gv = gv_fetchpv(name ? name :
+ GV * const gv = gv_fetchpv(name ? name :
(PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
GV_ADDMULTI, SVt_PVCV);
register CV *cv;
{
Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
/* STUB */
- (void)o;
+ PERL_UNUSED_ARG(o);
NORETURN_FUNCTION_END;
}
dVAR;
PL_hints |= HINT_BLOCK_SCOPE;
if (o->op_flags & OPf_KIDS) {
- SVOP *kid = (SVOP*)cUNOPo->op_first;
+ SVOP * const kid = (SVOP*)cUNOPo->op_first;
if (!kid) {
o->op_flags &= ~OPf_KIDS;
{
o = ck_fun(o);
if (o->op_flags & OPf_KIDS) {
- OP *kid = cUNOPo->op_first;
+ OP * const kid = cUNOPo->op_first;
if (kid->op_type == OP_ENTERSUB) {
(void) ref(kid, o->op_type);
if (kid->op_type != OP_RV2CV && !PL_error_count)
}
if (tmpstr) {
- name = SvPV(tmpstr, len);
+ name = SvPV_const(tmpstr, len);
sv_2mortal(tmpstr);
}
}
kid->op_type = OP_PUSHRE;
kid->op_ppaddr = PL_ppaddr[OP_PUSHRE];
scalar(kid);
- if (ckWARN(WARN_REGEXP) && ((PMOP *)kid)->op_pmflags & PMf_GLOBAL) {
+ if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL && ckWARN(WARN_REGEXP)) {
Perl_warner(aTHX_ packWARN(WARN_REGEXP),
"Use of /g modifier is meaningless in split");
}
OP *
Perl_ck_join(pTHX_ OP *o)
{
- if (ckWARN(WARN_SYNTAX)) {
- const OP *kid = cLISTOPo->op_first->op_sibling;
- if (kid && kid->op_type == OP_MATCH) {
+ const OP *kid = cLISTOPo->op_first->op_sibling;
+ if (kid && kid->op_type == OP_MATCH) {
+ if (ckWARN(WARN_SYNTAX)) {
const REGEXP *re = PM_GETRE(kPMOP);
const char *pmstr = re ? re->precomp : "STRING";
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
}
else {
delete_op = 1;
- if (ckWARN(WARN_ASSERTIONS) && !(PL_hints & HINT_ASSERTIONSSEEN)) {
+ if (!(PL_hints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) {
Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
"Impossible to activate assertion call");
}
case OP_EXEC:
o->op_opt = 1;
- if (ckWARN(WARN_SYNTAX) && o->op_next
- && o->op_next->op_type == OP_NEXTSTATE) {
+ if (o->op_next && o->op_next->op_type == OP_NEXTSTATE
+ && ckWARN(WARN_SYNTAX))
+ {
if (o->op_next->op_sibling &&
o->op_next->op_sibling->op_type != OP_EXIT &&
o->op_next->op_sibling->op_type != OP_WARN &&
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))
{