X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=cdd7aaf3c372bc570c93f6c478e4a9065199ff05;hb=6ef249b908f1fd6caec1b0140c6be9c66f4eb1f2;hp=55f05718cc61e2a41d8caf5a369aef0ce29dcbf0;hpb=e1a479c5e0c08fb10925261f03573261c69ca0dc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 55f0571..cdd7aaf 100644 --- a/op.c +++ b/op.c @@ -352,7 +352,7 @@ Perl_allocmy(pTHX_ const char *const name) { dVAR; PADOFFSET off; - const bool is_our = (PL_in_my == KEY_our); + const bool is_our = (PL_parser->in_my == KEY_our); /* complain about "my $" etc etc */ if (*name && @@ -373,24 +373,25 @@ Perl_allocmy(pTHX_ const char *const name) /* check for duplicate declaration */ pad_check_dup(name, is_our, (PL_curstash ? PL_curstash : PL_defstash)); - if (PL_in_my_stash && *name != '$') { + if (PL_parser->in_my_stash && *name != '$') { yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"%s\"", name, - is_our ? "our" : PL_in_my == KEY_state ? "state" : "my")); + is_our ? "our" + : PL_parser->in_my == KEY_state ? "state" : "my")); } /* allocate a spare slot and store the name in that slot */ off = pad_add_name(name, - PL_in_my_stash, + PL_parser->in_my_stash, (is_our /* $_ is always in main::, even with our */ ? (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash) : NULL ), 0, /* not fake */ - PL_in_my == KEY_state + PL_parser->in_my == KEY_state ); return off; } @@ -422,7 +423,7 @@ Perl_op_free(pTHX_ OP *o) dVAR; OPCODE type; - if (!o || o->op_static) + if (!o) return; if (o->op_latefreed) { if (o->op_latefree) @@ -782,8 +783,8 @@ S_scalarboolean(pTHX_ OP *o) if (ckWARN(WARN_SYNTAX)) { const line_t oldline = CopLINE(PL_curcop); - if (PL_copline != NOLINE) - CopLINE_set(PL_curcop, PL_copline); + if (PL_parser && PL_parser->copline != NOLINE) + CopLINE_set(PL_curcop, PL_parser->copline); Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Found = in conditional, should be =="); CopLINE_set(PL_curcop, oldline); } @@ -798,7 +799,8 @@ Perl_scalar(pTHX_ OP *o) OP *kid; /* assumes no premature commitment */ - if (!o || PL_error_count || (o->op_flags & OPf_WANT) + if (!o || (PL_parser && PL_parser->error_count) + || (o->op_flags & OPf_WANT) || o->op_type == OP_RETURN) { return o; @@ -896,7 +898,8 @@ Perl_scalarvoid(pTHX_ OP *o) /* assumes no premature commitment */ want = o->op_flags & OPf_WANT; - if ((want && want != OPf_WANT_SCALAR) || PL_error_count + if ((want && want != OPf_WANT_SCALAR) + || (PL_parser && PL_parser->error_count) || o->op_type == OP_RETURN) { return o; @@ -1141,7 +1144,8 @@ Perl_list(pTHX_ OP *o) OP *kid; /* assumes no premature commitment */ - if (!o || (o->op_flags & OPf_WANT) || PL_error_count + if (!o || (o->op_flags & OPf_WANT) + || (PL_parser && PL_parser->error_count) || o->op_type == OP_RETURN) { return o; @@ -1267,7 +1271,7 @@ Perl_mod(pTHX_ OP *o, I32 type) /* -1 = error on localize, 0 = ignore localize, 1 = ok to localize */ int localize = -1; - if (!o || PL_error_count) + if (!o || (PL_parser && PL_parser->error_count)) return o; if ((o->op_private & OPpTARGET_MY) @@ -1300,7 +1304,7 @@ Perl_mod(pTHX_ OP *o, I32 type) Perl_croak(aTHX_ "That use of $[ is unsupported"); break; case OP_STUB: - if (o->op_flags & OPf_PARENS || PL_madskills) + if ((o->op_flags & OPf_PARENS) || PL_madskills) break; goto nomod; case OP_ENTERSUB: @@ -1649,6 +1653,7 @@ S_scalar_mod_type(const OP *o, I32 type) case OP_RECV: case OP_ANDASSIGN: case OP_ORASSIGN: + case OP_DORASSIGN: return TRUE; default: return FALSE; @@ -1695,7 +1700,7 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref) dVAR; OP *kid; - if (!o || PL_error_count) + if (!o || (PL_parser && PL_parser->error_count)) return o; switch (o->op_type) { @@ -1817,7 +1822,6 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) /* fake up C */ ENTER; /* need to protect against side-effects of 'use' */ - SAVEINT(PL_expect); stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no; #define ATTRSMODULE "attributes" @@ -1944,7 +1948,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) dVAR; I32 type; - if (!o || PL_error_count) + if (!o || (PL_parser && PL_parser->error_count)) return o; type = o->op_type; @@ -1969,11 +1973,13 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */ yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"", OP_DESC(o), - PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my")); + PL_parser->in_my == KEY_our + ? "our" + : PL_parser->in_my == KEY_state ? "state" : "my")); } else if (attrs) { GV * const gv = cGVOPx_gv(cUNOPo->op_first); - PL_in_my = FALSE; - PL_in_my_stash = NULL; + PL_parser->in_my = FALSE; + PL_parser->in_my_stash = NULL; apply_attrs(GvSTASH(gv), (type == OP_RV2SV ? GvSV(gv) : type == OP_RV2AV ? (SV*)GvAV(gv) : @@ -1990,14 +1996,16 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) { yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"", OP_DESC(o), - PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my")); + PL_parser->in_my == KEY_our + ? "our" + : PL_parser->in_my == KEY_state ? "state" : "my")); return o; } else if (attrs && type != OP_PUSHMARK) { HV *stash; - PL_in_my = FALSE; - PL_in_my_stash = NULL; + PL_parser->in_my = FALSE; + PL_parser->in_my_stash = NULL; /* check for C when deciding package */ stash = PAD_COMPNAME_TYPE(o->op_targ); @@ -2007,7 +2015,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) } o->op_flags |= OPf_MOD; o->op_private |= OPpLVAL_INTRO; - if (PL_in_my == KEY_state) + if (PL_parser->in_my == KEY_state) o->op_private |= OPpPAD_STATE; return o; } @@ -2041,8 +2049,8 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs) else o = append_list(OP_LIST, (LISTOP*)o, (LISTOP*)rops); } - PL_in_my = FALSE; - PL_in_my_stash = NULL; + PL_parser->in_my = FALSE; + PL_parser->in_my_stash = NULL; return o; } @@ -2260,10 +2268,11 @@ Perl_localize(pTHX_ OP *o, I32 lex) NOOP; #endif else { - if ( PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',' + if ( PL_parser->bufptr > PL_parser->oldbufptr + && PL_parser->bufptr[-1] == ',' && ckWARN(WARN_PARENTHESIS)) { - char *s = PL_bufptr; + char *s = PL_parser->bufptr; bool sigil = FALSE; /* some heuristics to detect a potential error */ @@ -2286,8 +2295,13 @@ Perl_localize(pTHX_ OP *o, I32 lex) if (sigil && (*s == ';' || *s == '=')) { Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS), "Parentheses missing around \"%s\" list", - lex ? (PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my") - : "local"); + lex + ? (PL_parser->in_my == KEY_our + ? "our" + : PL_parser->in_my == KEY_state + ? "state" + : "my") + : "local"); } } } @@ -2295,8 +2309,8 @@ Perl_localize(pTHX_ OP *o, I32 lex) o = my(o); else o = mod(o, OP_NULL); /* a bit kludgey */ - PL_in_my = FALSE; - PL_in_my_stash = NULL; + PL_parser->in_my = FALSE; + PL_parser->in_my_stash = NULL; return o; } @@ -2362,7 +2376,7 @@ Perl_fold_constants(pTHX_ register OP *o) goto nope; } - if (PL_error_count) + if (PL_parser && PL_parser->error_count) goto nope; /* Don't try to run w/ errors */ for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) { @@ -2448,7 +2462,7 @@ Perl_gen_constant_list(pTHX_ register OP *o) const I32 oldtmps_floor = PL_tmps_floor; list(o); - if (PL_error_count) + if (PL_parser && PL_parser->error_count) return o; /* Don't attempt to run with errors */ PL_op = curop = LINKLIST(o); @@ -2817,7 +2831,7 @@ Perl_mad_free(pTHX_ MADPROP* mp) return; if (mp->mad_next) mad_free(mp->mad_next); -/* if (PL_lex_state != LEX_NOTPARSING && mp->mad_vlen) +/* if (PL_parser && PL_parser->lex_state != LEX_NOTPARSING && mp->mad_vlen) PerlIO_printf(PerlIO_stderr(), "DESTROYING '%c'=<%s>\n", mp->mad_key & 255, mp->mad_val); */ switch (mp->mad_type) { case MAD_NULL: @@ -3410,34 +3424,16 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg) pm = (PMOP*)o; if (expr->op_type == OP_CONST) { - STRLEN plen; SV * const pat = ((SVOP*)expr)->op_sv; - const char *p = SvPV_const(pat, plen); U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME; - if ((o->op_flags & OPf_SPECIAL) && (plen == 1 && *p == ' ')) { - U32 was_readonly = SvREADONLY(pat); - - if (was_readonly) { - if (SvFAKE(pat)) { - sv_force_normal_flags(pat, 0); - assert(!SvREADONLY(pat)); - was_readonly = 0; - } else { - SvREADONLY_off(pat); - } - } - - sv_setpvn(pat, "\\s+", 3); - SvFLAGS(pat) |= was_readonly; + if (o->op_flags & OPf_SPECIAL) + pm_flags |= RXf_SPLIT; - p = SvPV_const(pat, plen); - pm_flags |= RXf_SKIPWHITE; - } - if (DO_UTF8(pat)) + if (DO_UTF8(pat)) pm_flags |= RXf_UTF8; - /* FIXME - can we make this function take const char * args? */ - PM_SETRE(pm, CALLREGCOMP((char*)p, (char*)p + plen, pm_flags)); + + PM_SETRE(pm, CALLREGCOMP(pat, pm_flags)); #ifdef PERL_MAD op_getmad(expr,(OP*)pm,'e'); @@ -3484,8 +3480,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg) OP *curop; if (pm->op_pmflags & PMf_EVAL) { curop = NULL; - if (CopLINE(PL_curcop) < (line_t)PL_multi_end) - CopLINE_set(PL_curcop, (line_t)PL_multi_end); + if (CopLINE(PL_curcop) < (line_t)PL_parser->multi_end) + CopLINE_set(PL_curcop, (line_t)PL_parser->multi_end); } else if (repl->op_type == OP_CONST) curop = repl; @@ -3650,15 +3646,11 @@ Perl_package(pTHX_ OP *o) PL_curstash = gv_stashsv(sv, GV_ADD); - /* In case mg.c:Perl_magic_setisa faked - this package earlier, we clear the fake flag */ - HvMROMETA(PL_curstash)->fake = 0; - sv_setsv(PL_curstname, sv); PL_hints |= HINT_BLOCK_SCOPE; - PL_copline = NOLINE; - PL_expect = XSTATE; + PL_parser->copline = NOLINE; + PL_parser->expect = XSTATE; #ifndef PERL_MAD op_free(o); @@ -3782,8 +3774,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) */ PL_hints |= HINT_BLOCK_SCOPE; - PL_copline = NOLINE; - PL_expect = XSTATE; + PL_parser->copline = NOLINE; + PL_parser->expect = XSTATE; PL_cop_seqmax++; /* Purely for B::*'s benefit */ #ifdef PERL_MAD @@ -3861,17 +3853,19 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) sv = va_arg(*args, SV*); } } - { - const line_t ocopline = PL_copline; - COP * const ocurcop = PL_curcop; - const int oexpect = PL_expect; - utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), - veop, modname, imop); - PL_expect = oexpect; - PL_copline = ocopline; - PL_curcop = ocurcop; - } + /* utilize() fakes up a BEGIN { require ..; import ... }, so make sure + * that it has a PL_parser to play with while doing that, and also + * that it doesn't mess with any existing parser, by creating a tmp + * new parser with lex_start(). This won't actually be used for much, + * since pp_require() will create another parser for the real work. */ + + ENTER; + SAVEVPTR(PL_curcop); + lex_start(NULL, NULL, FALSE); + utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), + veop, modname, imop); + LEAVE; } OP * @@ -4065,45 +4059,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) o->op_private |= OPpASSIGN_COMMON; } - if ( ((left->op_private & OPpLVAL_INTRO) || ckWARN(WARN_MISC)) - && (left->op_type == OP_LIST - || (left->op_type == OP_NULL && left->op_targ == OP_LIST))) - { - OP* lop = ((LISTOP*)left)->op_first; - while (lop) { - if (lop->op_type == OP_PADSV || - lop->op_type == OP_PADAV || - lop->op_type == OP_PADHV || - lop->op_type == OP_PADANY) - { - if (lop->op_private & OPpPAD_STATE) { - if (left->op_private & OPpLVAL_INTRO) { - o->op_private |= OPpASSIGN_STATE; - /* hijacking PADSTALE for uninitialized state variables */ - SvPADSTALE_on(PAD_SVl(lop->op_targ)); - } - else { /* we already checked for WARN_MISC before */ - Perl_warner(aTHX_ packWARN(WARN_MISC), "State variable %s will be reinitialized", - PAD_COMPNAME_PV(lop->op_targ)); - } - } - } - lop = lop->op_sibling; - } - } - else if (((left->op_private & (OPpLVAL_INTRO | OPpPAD_STATE)) - == (OPpLVAL_INTRO | OPpPAD_STATE)) - && ( left->op_type == OP_PADSV - || left->op_type == OP_PADAV - || left->op_type == OP_PADHV - || left->op_type == OP_PADANY)) - { - o->op_private |= OPpASSIGN_STATE; - /* hijacking PADSTALE for uninitialized state variables */ - SvPADSTALE_on(PAD_SVl(left->op_targ)); - } - - if (right && right->op_type == OP_SPLIT) { + if (right && right->op_type == OP_SPLIT && !PL_madskills) { OP* tmpop = ((LISTOP*)right)->op_first; if (tmpop && (tmpop->op_type == OP_PUSHRE)) { PMOP * const pm = (PMOP*)tmpop; @@ -4133,11 +4089,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */ tmpop->op_sibling = NULL; /* don't free split */ right->op_next = tmpop->op_next; /* fix starting loc */ -#ifdef PERL_MAD - op_getmad(o,right,'R'); /* blow off assign */ -#else op_free(o); /* blow off assign */ -#endif right->op_flags &= ~OPf_WANT; /* "I don't know and I don't care." */ return right; @@ -4218,11 +4170,12 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) HINTS_REFCNT_UNLOCK; } - if (PL_copline == NOLINE) + if (PL_parser && PL_parser->copline == NOLINE) CopLINE_set(cop, CopLINE(PL_curcop)); else { - CopLINE_set(cop, PL_copline); - PL_copline = NOLINE; + CopLINE_set(cop, PL_parser->copline); + if (PL_parser) + PL_parser->copline = NOLINE; } #ifdef USE_ITHREADS CopFILE_set(cop, CopFILE(PL_curcop)); /* XXX share in a pvtable? */ @@ -4269,7 +4222,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */ if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL) - && (first->op_flags & OPf_KIDS)) { + && (first->op_flags & OPf_KIDS) + && !PL_madskills) { if (type == OP_AND || type == OP_OR) { if (type == OP_AND) type = OP_OR; @@ -4280,11 +4234,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) if (o->op_next) first->op_next = o->op_next; cUNOPo->op_first = NULL; -#ifdef PERL_MAD - op_getmad(o,first,'O'); -#else op_free(o); -#endif } } if (first->op_type == OP_CONST) { @@ -4368,7 +4318,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) } if (warnop) { const line_t oldline = CopLINE(PL_curcop); - CopLINE_set(PL_curcop, PL_copline); + CopLINE_set(PL_curcop, PL_parser->copline); Perl_warner(aTHX_ packWARN(WARN_MISC), "Value of %s%s can be \"0\"; test with defined()", PL_op_desc[warnop], @@ -4637,7 +4587,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my) redo = LINKLIST(listop); if (expr) { - PL_copline = (line_t)whileline; + PL_parser->copline = (line_t)whileline; scalar(listop); o = new_logop(OP_AND, 0, &expr, &listop); if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) { @@ -4796,7 +4746,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0); if (madsv) op_getmad(madsv, (OP*)loop, 'v'); - PL_copline = forline; + PL_parser->copline = forline; return newSTATEOP(0, label, wop); } @@ -4812,7 +4762,7 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label) o = newOP(type, OPf_SPECIAL); else { o = newPVOP(type, 0, savesharedpv(label->op_type == OP_CONST - ? SvPVx_nolen_const(((SVOP*)label)->op_sv) + ? SvPV_nolen_const(((SVOP*)label)->op_sv) : "")); } #ifdef PERL_MAD @@ -5249,11 +5199,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) = (block || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS) || PL_madskills) ? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT; - const char * const name = o ? SvPVx_nolen_const(cSVOPo->op_sv) : NULL; + const char * const name = o ? SvPV_nolen_const(cSVOPo->op_sv) : NULL; if (proto) { assert(proto->op_type == OP_CONST); - ps = SvPVx_const(((SVOP*)proto)->op_sv, ps_len); + ps = SvPV_const(((SVOP*)proto)->op_sv, ps_len); } else ps = NULL; @@ -5360,8 +5310,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) && (!const_sv || sv_cmp(cv_const_sv(cv), const_sv)))) { const line_t oldline = CopLINE(PL_curcop); - if (PL_copline != NOLINE) - CopLINE_set(PL_curcop, PL_copline); + if (PL_parser && PL_parser->copline != NOLINE) + CopLINE_set(PL_curcop, PL_parser->copline); Perl_warner(aTHX_ packWARN(WARN_REDEFINE), CvCONST(cv) ? "Constant subroutine %s redefined" : "Subroutine %s redefined", name); @@ -5491,7 +5441,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (ps) sv_setpvn((SV*)cv, ps, ps_len); - if (PL_error_count) { + if (PL_parser && PL_parser->error_count) { op_free(block); block = NULL; if (name) { @@ -5576,12 +5526,13 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } } - if (name && !PL_error_count) + if (name && ! (PL_parser && PL_parser->error_count)) process_special_blocks(name, gv, cv); } done: - PL_copline = NOLINE; + if (PL_parser) + PL_parser->copline = NOLINE; LEAVE_SCOPE(floor); return cv; } @@ -5677,7 +5628,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv) ENTER; SAVECOPLINE(PL_curcop); - CopLINE_set(PL_curcop, PL_copline); + CopLINE_set(PL_curcop, PL_parser ? PL_parser->copline : NOLINE); SAVEHINTS(); PL_hints &= ~HINT_BLOCK_SCOPE; @@ -5790,8 +5741,8 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename) const char *redefined_name = HvNAME_get(stash); if ( strEQ(redefined_name,"autouse") ) { const line_t oldline = CopLINE(PL_curcop); - if (PL_copline != NOLINE) - CopLINE_set(PL_curcop, PL_copline); + if (PL_parser && PL_parser->copline != NOLINE) + CopLINE_set(PL_curcop, PL_parser->copline); Perl_warner(aTHX_ packWARN(WARN_REDEFINE), CvCONST(cv) ? "Constant subroutine %s redefined" : "Subroutine %s redefined" @@ -5857,8 +5808,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) if ((cv = GvFORM(gv))) { if (ckWARN(WARN_REDEFINE)) { const line_t oldline = CopLINE(PL_curcop); - if (PL_copline != NOLINE) - CopLINE_set(PL_curcop, PL_copline); + if (PL_parser && PL_parser->copline != NOLINE) + CopLINE_set(PL_curcop, PL_parser->copline); Perl_warner(aTHX_ packWARN(WARN_REDEFINE), o ? "Format %"SVf" redefined" : "Format STDOUT redefined", SVfARG(cSVOPo->op_sv)); @@ -5885,7 +5836,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) #else op_free(o); #endif - PL_copline = NOLINE; + if (PL_parser) + PL_parser->copline = NOLINE; LEAVE_SCOPE(floor); #ifdef PERL_MAD return pegop; @@ -6277,7 +6229,8 @@ Perl_ck_exists(pTHX_ OP *o) 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 (kid->op_type != OP_RV2CV + && !(PL_parser && PL_parser->error_count)) Perl_croak(aTHX_ "%s argument is not a subroutine name", OP_DESC(o)); o->op_private |= OPpEXISTS_SUB; @@ -6793,7 +6746,7 @@ Perl_ck_grep(pTHX_ OP *o) PADOFFSET offset; o->op_ppaddr = PL_ppaddr[OP_GREPSTART]; - /* don't allocate gwop here, as we may leak it if PL_error_count > 0 */ + /* don't allocate gwop here, as we may leak it if PL_parser->error_count > 0 */ if (o->op_flags & OPf_STACKED) { OP* k; @@ -6814,7 +6767,7 @@ Perl_ck_grep(pTHX_ OP *o) else scalar(kid); o = ck_fun(o); - if (PL_error_count) + if (PL_parser && PL_parser->error_count) return o; kid = cLISTOPo->op_first->op_sibling; if (kid->op_type != OP_NULL) @@ -7002,7 +6955,10 @@ Perl_ck_sassign(pTHX_ OP *o) if ((PL_opargs[kid->op_type] & OA_TARGLEX) && !(kid->op_flags & OPf_STACKED) /* Cannot steal the second time! */ - && !(kid->op_private & OPpTARGET_MY)) + && !(kid->op_private & OPpTARGET_MY) + /* Keep the full thing for madskills */ + && !PL_madskills + ) { OP * const kkid = kid->op_sibling; @@ -7015,27 +6971,12 @@ Perl_ck_sassign(pTHX_ OP *o) /* Now we do not need PADSV and SASSIGN. */ kid->op_sibling = o->op_sibling; /* NULL */ cLISTOPo->op_first = NULL; -#ifdef PERL_MAD - op_getmad(o,kid,'O'); - op_getmad(kkid,kid,'M'); -#else op_free(o); op_free(kkid); -#endif kid->op_private |= OPpTARGET_MY; /* Used for context settings */ return kid; } } - if (kid->op_sibling) { - OP *kkid = kid->op_sibling; - if (kkid->op_type == OP_PADSV - && (kkid->op_private & OPpLVAL_INTRO) - && SvPAD_STATE(*av_fetch(PL_comppad_name, kkid->op_targ, FALSE))) { - o->op_private |= OPpASSIGN_STATE; - /* hijacking PADSTALE for uninitialized state variables */ - SvPADSTALE_on(PAD_SVl(kkid->op_targ)); - } - } return o; } @@ -7549,26 +7490,6 @@ Perl_ck_subr(pTHX_ OP *o) proto = SvPV((SV*)cv, len); proto_end = proto + len; } - if (CvASSERTION(cv)) { - U32 asserthints = 0; - HV *const hinthv = GvHV(PL_hintgv); - if (hinthv) { - SV **svp = hv_fetchs(hinthv, "assertions", FALSE); - if (svp && *svp) - asserthints = SvUV(*svp); - } - if (asserthints & HINT_ASSERTING) { - if (PERLDB_ASSERTION && PL_curstash != PL_debstash) - o->op_private |= OPpENTERSUB_DB; - } - else { - delete_op = 1; - if (!(asserthints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) { - Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS), - "Impossible to activate assertion call"); - } - } - } } } } @@ -8466,7 +8387,7 @@ Perl_peep(pTHX_ register OP *o) LEAVE; } -char* +const char* Perl_custom_op_name(pTHX_ const OP* o) { dVAR; @@ -8486,7 +8407,7 @@ Perl_custom_op_name(pTHX_ const OP* o) return SvPV_nolen(HeVAL(he)); } -char* +const char* Perl_custom_op_desc(pTHX_ const OP* o) { dVAR;