bool
_runops_debug(int flag)
{
dTHX;
bool d = PL_runops == MEMBER_TO_FPTR(Perl_runops_debug);
if (flag >= 0)
PL_runops
= MEMBER_TO_FPTR(flag ? Perl_runops_debug : Perl_runops_standard);
return d;
}
OP *
Perl_mod(pTHX_ OP *o, I32 type)
{
dVAR;
OP **tokid;
/* -1 = error on localize, 0 = ignore localize, 1 = ok to localize */
int localize = -1;
if (!o || (PL_parser && PL_parser->error_count))
return o;
if ((o->op_flags & OPf_TARGET_MY)
&& (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
{
return o;
}
switch (o->op_type) {
case OP_UNDEF:
localize = 0;
return o;
case OP_STUB:
if ((o->op_flags & OPf_PARENS) || PL_madskills)
break;
goto nomod;
default:
nomod:
/* grep, foreach, subcalls, refgen */
if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_SREFGEN)
break;
Perl_croak_at(aTHX_ o->op_location,
"Can't modify %s in %s",
(o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
? "do block"
: OP_DESC(o)),
type ? PL_op_desc[type] : "local");
return o;
case OP_PREINC:
case OP_PREDEC:
case OP_POW:
case OP_MULTIPLY:
case OP_DIVIDE:
case OP_MODULO:
case OP_REPEAT:
case OP_ADD:
case OP_SUBTRACT:
case OP_CONCAT:
case OP_LEFT_SHIFT:
case OP_RIGHT_SHIFT:
case OP_BIT_AND:
case OP_BIT_XOR:
case OP_BIT_OR:
case OP_I_MULTIPLY:
case OP_I_DIVIDE:
case OP_I_MODULO:
case OP_I_ADD:
case OP_I_SUBTRACT:
if (!(o->op_flags & OPf_STACKED))
goto nomod;
break;
case OP_COND_EXPR:
localize = 1;
for (tokid = &(cUNOPo->op_first->op_sibling); *tokid; tokid = &((*tokid)->op_sibling))
*tokid = mod(*tokid, type);
break;
case OP_RV2GV:
/* if (scalar_mod_type(o, type)) */
/* goto nomod; */
doref(cUNOPo->op_first, o->op_type, TRUE);
localize = 1;
break;
case OP_ASLICE:
case OP_HSLICE:
localize = 1;
/* FALL THROUGH */
case OP_NEXTSTATE:
case OP_DBSTATE:
break;
case OP_RV2CV:
case OP_RV2AV:
case OP_RV2HV:
case OP_RV2SV:
doref(cUNOPo->op_first, o->op_type, TRUE);
localize = 1;
/* FALL THROUGH */
case OP_GV:
PL_hints |= HINT_BLOCK_SCOPE;
break;
case OP_SASSIGN:
case OP_ANDASSIGN:
case OP_ORASSIGN:
case OP_DORASSIGN:
break;
case OP_AELEMFAST:
localize = -1;
break;
case OP_EXPAND:
cUNOPo->op_first = mod(cUNOPo->op_first, type);
break;
case OP_DOTDOTDOT:
case OP_PLACEHOLDER:
localize = 0;
break;
case OP_PADSV:
if (!type) /* local() */
Perl_croak(aTHX_ "Can't localize lexical variable %s",
PAD_COMPNAME_PV(o->op_targ));
break;
case OP_MAGICSV:
localize = 1;
if ( type && type != OP_SASSIGN && type != OP_SUBST )
goto nomod;
break;
case OP_PUSHMARK:
localize = 0;
break;
case OP_KEYS:
goto nomod;
break;
case OP_AELEM:
case OP_HELEM:
o = op_mod_assign(
o,
&(cBINOPo->op_first),
type == OP_NULL ? o->op_type : type
);
localize = 1;
break;
case OP_ENTERSUB_SAVE:
o = op_mod_assign(
o,
&(cUNOPo->op_first),
type == OP_NULL ? o->op_type : type
);
localize = 1;
break;
case OP_ENTERSUB:
if ( ! type ) {
/* add localize opcode */
const PADOFFSET po = pad_alloc(OP_SASSIGN, SVs_PADTMP);
o->op_targ = po;
o->op_private |= OPpENTERSUB_SAVEARGS;
o = newUNOP(OP_ENTERSUB_SAVE, 0, scalar(o), o->op_location);
o->op_targ = po;
}
localize = 1;
break;
case OP_SCOPE:
case OP_LEAVE:
case OP_ENTER:
case OP_LINESEQ:
localize = 0;
if (o->op_flags & OPf_KIDS)
cLISTOPo->op_last = mod(cLISTOPo->op_last, type);
break;
case OP_NULL:
localize = 0;
if (o->op_flags & OPf_SPECIAL) /* do BLOCK */
goto nomod;
else if (!(o->op_flags & OPf_KIDS))
break;
if (o->op_targ != OP_LIST) {
cBINOPo->op_first = mod(cBINOPo->op_first, type);
break;
}
/* FALL THROUGH */
case OP_HASHEXPAND:
case OP_ARRAYEXPAND:
case OP_LIST:
localize = 0;
for (tokid = &(cLISTOPo->op_first); *tokid; tokid = &((*tokid)->op_sibling))
*tokid = mod(*tokid, type);
break;
case OP_ANONARRAY:
case OP_ANONHASH:
case OP_ANONSCALAR:
if ( ! type ) {
/* propagate localize */
for (tokid = &(cLISTOPo->op_first); *tokid; tokid = &((*tokid)->op_sibling))
*tokid = mod(*tokid, type);
}
localize = 0;
break;
case OP_LISTLAST:
localize = 0;
if (o->op_flags & OPf_KIDS)
cLISTOPo->op_last = mod(cLISTOPo->op_last, type);
break;
case OP_LISTFIRST:
localize = 0;
if (o->op_flags & OPf_KIDS)
cLISTOPo->op_first->op_sibling = mod(cLISTOPo->op_first->op_sibling, type);
break;
case OP_RETURN:
goto nomod;
break; /* mod()ing was handled by ck_return() */
}
/* [20011101.069] File test operators interpret OPf_REF to mean that
their argument is a filehandle; thus \stat(".") should not set
it. AMS 20011102 */
if (type == OP_SREFGEN &&
PL_check[o->op_type] == MEMBER_TO_FPTR(Perl_ck_ftst))
return o;
o->op_flags |= OPf_MOD;
if (type == OP_SASSIGN)
o->op_flags |= OPf_SPECIAL|OPf_REF;
else if (!type) { /* local() */
switch (localize) {
case 1:
o->op_private |= OPpLVAL_INTRO;
o->op_flags &= ~OPf_SPECIAL;
PL_hints |= HINT_BLOCK_SCOPE;
break;
case 0:
break;
case -1:
Perl_croak(aTHX_ "Can't localize %s", OP_DESC(o));
}
}
else if (type != OP_GREPSTART && type != OP_ENTERSUB)
o->op_flags |= OPf_REF;
return o;
}
