op_free(kid);
}
}
- if (type == OP_NULL)
- type = (OPCODE)o->op_targ;
#ifdef PERL_DEBUG_READONLY_OPS
Slab_to_rw(o);
/* COP* is not cleared by op_clear() so that we may track line
* numbers etc even after null() */
- if (type == OP_NEXTSTATE || type == OP_DBSTATE) {
+ if (type == OP_NEXTSTATE || type == OP_DBSTATE
+ || (type == OP_NULL /* the COP might have been null'ed */
+ && ((OPCODE)o->op_targ == OP_NEXTSTATE
+ || (OPCODE)o->op_targ == OP_DBSTATE))) {
cop_free((COP*)o);
}
+ if (type == OP_NULL)
+ type = (OPCODE)o->op_targ;
+
op_clear(o);
if (o->op_latefree) {
o->op_latefreed = 1;
switch (o->op_type) {
case OP_NULL: /* Was holding old type, if any. */
if (PL_madskills && o->op_targ != OP_NULL) {
- o->op_type = (optype)o->op_targ;
+ o->op_type = (Optype)o->op_targ;
o->op_targ = 0;
goto retry;
}
{
PERL_ARGS_ASSERT_COP_FREE;
- CopLABEL_free(cop);
CopFILE_free(cop);
CopSTASH_free(cop);
if (! specialWARN(cop->cop_warnings))
case 3:
/* Something tried to die. Abandon constant folding. */
/* Pretend the error never happened. */
- sv_setpvn(ERRSV,"",0);
+ CLEAR_ERRSV();
o->op_next = old_next;
break;
default:
CopHINTS_set(&PL_compiling, CopHINTS_get(cop));
cop->op_next = (OP*)cop;
- if (label) {
- CopLABEL_set(cop, label);
- PL_hints |= HINT_BLOCK_SCOPE;
- }
cop->cop_seq = seq;
/* CopARYBASE is now "virtual", in that it's stored as a flag bit in
CopHINTS and a possible value in cop_hints_hash, so no need to copy it.
cop->cop_hints_hash->refcounted_he_refcnt++;
HINTS_REFCNT_UNLOCK;
}
+ if (label) {
+ cop->cop_hints_hash
+ = Perl_store_cop_label(aTHX_ cop->cop_hints_hash, label);
+
+ PL_hints |= HINT_BLOCK_SCOPE;
+ /* It seems that we need to defer freeing this pointer, as other parts
+ of the grammar end up wanting to copy it after this op has been
+ created. */
+ SAVEFREEPV(label);
+ }
if (PL_parser && PL_parser->copline == NOLINE)
CopLINE_set(cop, CopLINE(PL_curcop));
}
}
+ if (flags & OPf_SPECIAL)
+ op_null((OP*)cop);
return prepend_elem(OP_LINESEQ, (OP*)cop, o);
}
PERL_ARGS_ASSERT_NEWGIVWHENOP;
NewOp(1101, enterop, 1, LOGOP);
- enterop->op_type = (optype)enter_opcode;
+ enterop->op_type = (Optype)enter_opcode;
enterop->op_ppaddr = PL_ppaddr[enter_opcode];
enterop->op_flags = (U8) OPf_KIDS;
enterop->op_targ = ((entertarg == NOT_IN_PAD) ? 0 : entertarg);
else if (kid->op_type == OP_AELEM)
o->op_flags |= OPf_SPECIAL;
else if (kid->op_type != OP_HELEM)
- Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element",
+ Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or a subroutine",
OP_DESC(o));
op_null(kid);
}
if (table) {
SV **svp = hv_fetchs(table, "open_IN", FALSE);
if (svp && *svp) {
- const I32 mode = mode_from_discipline(*svp);
+ STRLEN len = 0;
+ const char *d = SvPV_const(*svp, len);
+ const I32 mode = mode_from_discipline(d, len);
if (mode & O_BINARY)
o->op_private |= OPpOPEN_IN_RAW;
else if (mode & O_TEXT)
svp = hv_fetchs(table, "open_OUT", FALSE);
if (svp && *svp) {
- const I32 mode = mode_from_discipline(*svp);
+ STRLEN len = 0;
+ const char *d = SvPV_const(*svp, len);
+ const I32 mode = mode_from_discipline(d, len);
if (mode & O_BINARY)
o->op_private |= OPpOPEN_OUT_RAW;
else if (mode & O_TEXT)