#ifdef PERL_MAD
/* if (o->op_madprop && o->op_madprop->mad_next)
abort(); */
- mad_free(o->op_madprop);
- o->op_madprop = 0;
+ /* FIXME for MAD - if I uncomment these two lines t/op/pack.t fails with
+ "modification of a read only value" for a reason I can't fathom why.
+ It's the "" stringification of $_, where $_ was set to '' in a foreach
+ loop, but it defies simplification into a small test case.
+ However, commenting them out has caused ext/List/Util/t/weak.t to fail
+ the last test. */
+ /*
+ mad_free(o->op_madprop);
+ o->op_madprop = 0;
+ */
#endif
retry:
Perl_newTOKEN(pTHX_ I32 optype, YYSTYPE lval, MADPROP* madprop)
{
TOKEN *tk;
- Newz(1101, tk, 1, TOKEN);
+ Newxz(tk, 1, TOKEN);
tk->tk_type = (OPCODE)optype;
tk->tk_type = 12345;
tk->tk_lval = lval;
}
}
else {
- PerlIO_printf(PerlIO_stderr(), "DESTROYING op = %0x\n", from);
+ PerlIO_printf(PerlIO_stderr(),
+ "DESTROYING op = %0"UVxf"\n", PTR2UV(from));
op_free(from);
}
}
Perl_newMADPROP(pTHX_ char key, char type, void* val, I32 vlen)
{
MADPROP *mp;
- Newz(1101, mp, 1, MADPROP);
+ Newxz(mp, 1, MADPROP);
mp->mad_next = 0;
mp->mad_key = key;
mp->mad_vlen = vlen;
#endif
Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
{
-#ifdef PERL_MAD
- /* FIXME for MAD - shouldn't this be done at the return statement? And
- given that the return statement is never reached, surely this currently
- is a leak? */
+#if 0
+ /* This would be the return value, but the return cannot be reached. */
OP* pegop = newOP(OP_NULL, 0);
#endif
SAVEFREEOP(block);
Perl_croak(aTHX_ "\"my sub\" not yet implemented");
#ifdef PERL_MAD
- return pegop;
+ NORETURN_FUNCTION_END;
#endif
}
/* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>
* before we clobber PL_compcv.
*/
- if (cv && !(block
+ if (cv && (!block
#ifdef PERL_MAD
|| block->op_type == OP_NULL
#endif
listkids(o);
}
else if (PL_opargs[type] & OA_DEFGV) {
- OP *newop = newUNOP(type, 0, newDEFSVOP());
#ifdef PERL_MAD
+ OP *newop = newUNOP(type, 0, newDEFSVOP());
op_getmad(o,newop,'O');
+ return newop;
#else
+ /* Ordering of these two is important to keep f_map.t passing. */
op_free(o);
+ return newUNOP(type, 0, newDEFSVOP());
#endif
- return newop;
}
if (oa) {
Perl_ck_grep(pTHX_ OP *o)
{
dVAR;
- LOGOP *gwop;
+ LOGOP *gwop = NULL;
OP *kid;
const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
I32 offset;
o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
- NewOp(1101, gwop, 1, LOGOP);
+ /* don't allocate gwop here, as we may leak it if PL_error_count > 0 */
if (o->op_flags & OPf_STACKED) {
OP* k;
for (k = cUNOPx(kid)->op_first; k; k = k->op_next) {
kid = k;
}
+ NewOp(1101, gwop, 1, LOGOP);
kid->op_next = (OP*)gwop;
o->op_flags &= ~OPf_STACKED;
}
Perl_croak(aTHX_ "panic: ck_grep");
kid = kUNOP->op_first;
+ if (!gwop)
+ NewOp(1101, gwop, 1, LOGOP);
gwop->op_type = type;
gwop->op_ppaddr = PL_ppaddr[type];
gwop->op_first = listkids(o);
if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
OP * const kid = cUNOPo->op_first;
- OP * newop
- = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
- append_elem(OP_LIST, kid,
- scalar(newUNOP(OP_RV2CV, 0,
- newGVOP(OP_GV, 0,
- gv))))));
+ OP * newop;
+
cUNOPo->op_first = 0;
-#ifdef PERL_MAD
- op_getmad(o,newop,'O');
-#else
+#ifndef PERL_MAD
op_free(o);
#endif
+ newop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, kid,
+ scalar(newUNOP(OP_RV2CV, 0,
+ newGVOP(OP_GV, 0,
+ gv))))));
+ op_getmad(o,newop,'O');
return newop;
}