X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=bcf4fb63ad362ce1d1ed7313fa7fdb1fb86ee46f;hb=1dd9311ab0a647f516752dd7368cf0b3f3ae13a4;hp=2c6b675475d7c1a9cf02db103f8afcd4940f7308;hpb=f52873be661eb80fe4a715a931890444c8287cb7;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 2c6b675..bcf4fb6 100644 --- a/op.c +++ b/op.c @@ -1,6 +1,7 @@ /* op.c * - * Copyright (c) 1991-2003, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -193,7 +194,7 @@ Perl_allocmy(pTHX_ char *name) /* check for duplicate declaration */ pad_check_dup(name, - PL_in_my == KEY_our, + (bool)(PL_in_my == KEY_our), (PL_curstash ? PL_curstash : PL_defstash) ); @@ -887,10 +888,23 @@ S_modkids(pTHX_ OP *o, I32 type) return o; } +/* Propagate lvalue ("modifiable") context to an op and it's children. + * 'type' represents the context type, roughly based on the type of op that + * would do the modifying, although local() is represented by OP_NULL. + * It's responsible for detecting things that can't be modified, flag + * things that need to behave specially in an lvalue context (e.g., "$$x = 5" + * might have to vivify a reference in $x), and so on. + * + * For example, "$a+1 = 2" would cause mod() to be called with o being + * OP_ADD and type being OP_SASSIGN, and would output an error. + */ + OP * Perl_mod(pTHX_ OP *o, I32 type) { OP *kid; + /* -1 = error on localize, 0 = ignore localize, 1 = ok to localize */ + int localize = -1; if (!o || PL_error_count) return o; @@ -903,6 +917,7 @@ Perl_mod(pTHX_ OP *o, I32 type) switch (o->op_type) { case OP_UNDEF: + localize = 0; PL_modcount++; return o; case OP_CONST: @@ -1059,6 +1074,7 @@ Perl_mod(pTHX_ OP *o, I32 type) break; case OP_COND_EXPR: + localize = 1; for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling) mod(kid, type); break; @@ -1079,6 +1095,7 @@ Perl_mod(pTHX_ OP *o, I32 type) case OP_HSLICE: if (type == OP_LEAVESUBLV) o->op_private |= OPpMAYBE_LVSUB; + localize = 1; /* FALL THROUGH */ case OP_AASSIGN: case OP_NEXTSTATE: @@ -1087,6 +1104,7 @@ Perl_mod(pTHX_ OP *o, I32 type) break; case OP_RV2SV: ref(cUNOPo->op_first, o->op_type); + localize = 1; /* FALL THROUGH */ case OP_GV: case OP_AV2ARYLEN: @@ -1095,7 +1113,11 @@ Perl_mod(pTHX_ OP *o, I32 type) case OP_ANDASSIGN: case OP_ORASSIGN: case OP_DORASSIGN: + PL_modcount++; + break; + case OP_AELEMFAST: + localize = 1; PL_modcount++; break; @@ -1111,17 +1133,13 @@ Perl_mod(pTHX_ OP *o, I32 type) /* FALL THROUGH */ case OP_PADSV: PL_modcount++; - if (!type) - { /* XXX DAPM 2002.08.25 tmp assert test */ - /* XXX */ assert(av_fetch(PL_comppad_name, (o->op_targ), FALSE)); - /* XXX */ assert(*av_fetch(PL_comppad_name, (o->op_targ), FALSE)); - + if (!type) /* local() */ Perl_croak(aTHX_ "Can't localize lexical variable %s", PAD_COMPNAME_PV(o->op_targ)); - } break; case OP_PUSHMARK: + localize = 0; break; case OP_KEYS: @@ -1152,6 +1170,7 @@ Perl_mod(pTHX_ OP *o, I32 type) o->op_private |= OPpLVAL_DEFER; if (type == OP_LEAVESUBLV) o->op_private |= OPpMAYBE_LVSUB; + localize = 1; PL_modcount++; break; @@ -1159,11 +1178,13 @@ Perl_mod(pTHX_ OP *o, I32 type) case OP_LEAVE: case OP_ENTER: case OP_LINESEQ: + localize = 0; if (o->op_flags & OPf_KIDS) 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)) @@ -1174,6 +1195,7 @@ Perl_mod(pTHX_ OP *o, I32 type) } /* FALL THROUGH */ case OP_LIST: + localize = 0; for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) mod(kid, type); break; @@ -1196,10 +1218,21 @@ Perl_mod(pTHX_ OP *o, I32 type) if (type == OP_AASSIGN || type == OP_SASSIGN) o->op_flags |= OPf_SPECIAL|OPf_REF; - else if (!type) { - o->op_private |= OPpLVAL_INTRO; - o->op_flags &= ~OPf_SPECIAL; - PL_hints |= HINT_BLOCK_SCOPE; + 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: + if (ckWARN(WARN_SYNTAX)) { + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), + "Useless localization of %s", OP_DESC(o)); + } + } } else if (type != OP_GREPSTART && type != OP_ENTERSUB && type != OP_LEAVESUBLV) @@ -1796,8 +1829,11 @@ Perl_newPROG(pTHX_ OP *o) CALL_PEEP(PL_eval_start); } else { - if (o->op_type == OP_STUB) + if (o->op_type == OP_STUB) { + PL_comppad_name = 0; + PL_compcv = 0; return; + } PL_main_root = scope(sawparens(scalarvoid(o))); PL_curcop = &PL_compiling; PL_main_start = LINKLIST(PL_main_root); @@ -1837,14 +1873,23 @@ Perl_localize(pTHX_ OP *o, I32 lex) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') { char *s = PL_bufptr; + int sigil = 0; - while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s) || strchr("@$%, ", *s))) + /* some heuristics to detect a potential error */ + while (*s && (strchr(", \t\n", *s) + || (strchr("@$%*", *s) && ++sigil) )) s++; - - if (*s == ';' || *s == '=') - Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS), - "Parentheses missing around \"%s\" list", - lex ? (PL_in_my == KEY_our ? "our" : "my") : "local"); + if (sigil) { + while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s) + || strchr("@$%*, \t\n", *s))) + s++; + + if (*s == ';' || *s == '=') + Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS), + "Parentheses missing around \"%s\" list", + lex ? (PL_in_my == KEY_our ? "our" : "my") + : "local"); + } } } if (lex) @@ -1967,6 +2012,8 @@ Perl_gen_constant_list(pTHX_ register OP *o) o->op_type = OP_RV2AV; o->op_ppaddr = PL_ppaddr[OP_RV2AV]; + o->op_flags &= ~OPf_REF; /* treat \(1..2) like an ordinary list */ + o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */ o->op_seq = 0; /* needs to be revisited in peep() */ curop = ((UNOP*)o)->op_first; ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--)); @@ -2127,7 +2174,7 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) listop->op_last = pushop; } - return (OP*)listop; + return CHECKOP(type, listop); } OP * @@ -2250,13 +2297,13 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) U8* tend = t + tlen; U8* rend = r + rlen; STRLEN ulen; - U32 tfirst = 1; - U32 tlast = 0; - I32 tdiff; - U32 rfirst = 1; - U32 rlast = 0; - I32 rdiff; - I32 diff; + UV tfirst = 1; + UV tlast = 0; + IV tdiff; + UV rfirst = 1; + UV rlast = 0; + IV rdiff; + IV diff; I32 none = 0; U32 max = 0; I32 bits; @@ -2564,7 +2611,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags) PmopSTASH_set(pmop,PL_curstash); } - return (OP*)pmop; + return CHECKOP(type, pmop); } OP * @@ -2611,6 +2658,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) : OPf_KIDS); rcop->op_private = 1; rcop->op_other = o; + /* /$x/ may cause an eval, since $x might be qr/(?{..})/ */ + PL_cv_has_eval = 1; /* establish postfix order */ if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL)) { @@ -2630,7 +2679,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) OP *curop; if (pm->op_pmflags & PMf_EVAL) { curop = 0; - if (CopLINE(PL_curcop) < PL_multi_end) + if (CopLINE(PL_curcop) < (line_t)PL_multi_end) CopLINE_set(PL_curcop, (line_t)PL_multi_end); } else if (repl->op_type == OP_CONST) @@ -2789,13 +2838,13 @@ Perl_package(pTHX_ OP *o) } void -Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) +Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) { OP *pack; OP *imop; OP *veop; - if (id->op_type != OP_CONST) + if (idop->op_type != OP_CONST) Perl_croak(aTHX_ "Module name must be constant"); veop = Nullop; @@ -2813,8 +2862,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) if (version->op_type != OP_CONST || !SvNIOKp(vesv)) Perl_croak(aTHX_ "Version number must be constant number"); - /* Make copy of id so we don't free it twice */ - pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv)); + /* Make copy of idop so we don't free it twice */ + pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv)); /* Fake up a method call to VERSION */ meth = newSVpvn("VERSION",7); @@ -2831,14 +2880,14 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) /* Fake up an import/unimport */ if (arg && arg->op_type == OP_STUB) imop = arg; /* no import on explicit () */ - else if (SvNIOKp(((SVOP*)id)->op_sv)) { + else if (SvNIOKp(((SVOP*)idop)->op_sv)) { imop = Nullop; /* use 5.0; */ } else { SV *meth; - /* Make copy of id so we don't free it twice */ - pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv)); + /* Make copy of idop so we don't free it twice */ + 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); @@ -2858,7 +2907,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) Nullop, append_elem(OP_LINESEQ, append_elem(OP_LINESEQ, - newSTATEOP(0, Nullch, newUNOP(OP_REQUIRE, 0, id)), + newSTATEOP(0, Nullch, newUNOP(OP_REQUIRE, 0, idop)), newSTATEOP(0, Nullch, veop)), newSTATEOP(0, Nullch, imop) )); @@ -2882,6 +2931,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) PL_hints |= HINT_BLOCK_SCOPE; PL_copline = NOLINE; PL_expect = XSTATE; + PL_cop_seqmax++; /* Purely for B::*'s benefit */ } /* @@ -3368,6 +3418,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) first->op_next = (OP*)logop; first->op_sibling = other; + CHECKOP(type,logop); + o = newUNOP(OP_NULL, 0, (OP*)logop); other->op_next = o; @@ -3412,6 +3464,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) logop->op_other = LINKLIST(trueop); logop->op_next = LINKLIST(falseop); + CHECKOP(OP_COND_EXPR, /* that's logop->op_type */ + logop); /* establish postfix order */ start = LINKLIST(first); @@ -3576,11 +3630,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP * if (!next) next = unstack; cont = append_elem(OP_LINESEQ, cont, unstack); - if ((line_t)whileline != NOLINE) { - PL_copline = (line_t)whileline; - cont = append_elem(OP_LINESEQ, cont, - newSTATEOP(0, Nullch, Nullop)); - } } listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont); @@ -3633,13 +3682,16 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo OP *wop; PADOFFSET padoff = 0; I32 iterflags = 0; + I32 iterpflags = 0; if (sv) { if (sv->op_type == OP_RV2SV) { /* symbol table variable */ + iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */ sv->op_type = OP_RV2GV; sv->op_ppaddr = PL_ppaddr[OP_RV2GV]; } else if (sv->op_type == OP_PADSV) { /* private variable */ + iterpflags = sv->op_private & OPpLVAL_INTRO; /* for my $x () */ padoff = sv->op_targ; sv->op_targ = 0; op_free(sv); @@ -3698,6 +3750,9 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo loop = (LOOP*)list(convert(OP_ENTERITER, iterflags, append_elem(OP_LIST, expr, scalar(sv)))); assert(!loop->op_next); + /* for my $x () sets OPpLVAL_INTRO; + * for our $x () sets OPpOUR_INTRO; both only used by Deparse.pm */ + loop->op_private = (U8)iterpflags; #ifdef PL_OP_SLAB_ALLOC { LOOP *tmp; @@ -3843,6 +3898,26 @@ Perl_cv_const_sv(pTHX_ CV *cv) return (SV*)CvXSUBANY(cv).any_ptr; } +/* op_const_sv: examine an optree to determine whether it's in-lineable. + * Can be called in 3 ways: + * + * !cv + * look for a single OP_CONST with attached value: return the value + * + * cv && CvCLONE(cv) && !CvCONST(cv) + * + * examine the clone prototype, and if contains only a single + * OP_CONST referencing a pad const, or a single PADSV referencing + * an outer lexical, return a non-zero value to indicate the CV is + * a candidate for "constizing" at clone time + * + * cv && CvCONST(cv) + * + * We have just cloned an anon prototype that was marked as a const + * candidiate. Try to grab the current value, and in the case of + * PADSV, ignore it if it has multiple references. Return the value. + */ + SV * Perl_op_const_sv(pTHX_ OP *o, CV *cv) { @@ -3871,26 +3946,31 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv) return Nullsv; if (type == OP_CONST && cSVOPo->op_sv) sv = cSVOPo->op_sv; - else if ((type == OP_PADSV || type == OP_CONST) && cv) { + else if (cv && type == OP_CONST) { sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ); if (!sv) return Nullsv; - if (CvCONST(cv)) { - /* We get here only from cv_clone2() while creating a closure. - Copy the const value here instead of in cv_clone2 so that - SvREADONLY_on doesn't lead to problems when leaving - scope. - */ + } + else if (cv && type == OP_PADSV) { + if (CvCONST(cv)) { /* newly cloned anon */ + sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ); + /* the candidate should have 1 ref from this pad and 1 ref + * from the parent */ + if (!sv || SvREFCNT(sv) != 2) + return Nullsv; sv = newSVsv(sv); + SvREADONLY_on(sv); + return sv; + } + else { + if (PAD_COMPNAME_FLAGS(o->op_targ) & SVf_FAKE) + sv = &PL_sv_undef; /* an arbitrary non-null value */ } - if (!SvREADONLY(sv) && SvREFCNT(sv) > 1) - return Nullsv; } - else + else { return Nullsv; + } } - if (sv) - SvREADONLY_on(sv); return sv; } @@ -4092,6 +4172,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv); /* ... before we throw it away */ SvREFCNT_dec(PL_compcv); + PL_compcv = cv; if (PERLDB_INTER)/* Advice debugger on the new sub. */ ++PL_sub_generation; } @@ -4191,7 +4272,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I') goto done; - if (strEQ(s, "BEGIN")) { + if (strEQ(s, "BEGIN") && !PL_error_count) { I32 oldscope = PL_scopestack_ix; ENTER; SAVECOPFILE(&PL_compiling); @@ -4273,7 +4354,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv) CopSTASH_set(PL_curcop,stash); } - cv = newXS(name, const_sv_xsub, __FILE__); + cv = newXS(name, const_sv_xsub, savepv(CopFILE(PL_curcop))); CvXSUBANY(cv).any_ptr = sv; CvCONST_on(cv); sv_setpv((SV*)cv, ""); /* prototype is "" */ @@ -4605,13 +4686,17 @@ Perl_ck_bitop(pTHX_ OP *o) (op) == OP_NE || (op) == OP_I_NE || \ (op) == OP_NCMP || (op) == OP_I_NCMP) o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK); - if (o->op_type == OP_BIT_OR - || o->op_type == OP_BIT_AND - || o->op_type == OP_BIT_XOR) + if (!(o->op_flags & OPf_STACKED) /* Not an assignment */ + && (o->op_type == OP_BIT_OR + || o->op_type == OP_BIT_AND + || o->op_type == OP_BIT_XOR)) { - OPCODE typfirst = cBINOPo->op_first->op_type; - OPCODE typlast = cBINOPo->op_first->op_sibling->op_type; - if (OP_IS_NUMCOMPARE(typfirst) || OP_IS_NUMCOMPARE(typlast)) + OP * left = cBINOPo->op_first; + OP * right = left->op_sibling; + if ((OP_IS_NUMCOMPARE(left->op_type) && + (left->op_flags & OPf_PARENS) == 0) || + (OP_IS_NUMCOMPARE(right->op_type) && + (right->op_flags & OPf_PARENS) == 0)) if (ckWARN(WARN_PRECEDENCE)) Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE), "Possible precedence problem on bitwise %c operator", @@ -4625,8 +4710,9 @@ Perl_ck_bitop(pTHX_ OP *o) OP * Perl_ck_concat(pTHX_ OP *o) { - if (cUNOPo->op_first->op_type == OP_CONCAT) - o->op_flags |= OPf_STACKED; + OP *kid = cUNOPo->op_first; + if (kid->op_type == OP_CONCAT && !(kUNOP->op_first->op_flags & OPf_MOD)) + o->op_flags |= OPf_STACKED; return o; } @@ -4738,8 +4824,10 @@ Perl_ck_eval(pTHX_ OP *o) enter->op_other = o; return o; } - else + else { scalar((OP*)kid); + PL_cv_has_eval = 1; + } } else { op_free(o); @@ -4932,6 +5020,11 @@ Perl_ck_ftst(pTHX_ OP *o) op_free(o); o = newop; } + else { + if ((PL_hints & HINT_FILETEST_ACCESS) && + OP_IS_FILETEST_ACCESS(o)) + o->op_private |= OPpFT_ACCESS; + } } else { op_free(o); @@ -5086,10 +5179,6 @@ Perl_ck_fun(pTHX_ OP *o) */ priv = OPpDEREF; if (kid->op_type == OP_PADSV) { - /*XXX DAPM 2002.08.25 tmp assert test */ - /*XXX*/ assert(av_fetch(PL_comppad_name, (kid->op_targ), FALSE)); - /*XXX*/ assert(*av_fetch(PL_comppad_name, (kid->op_targ), FALSE)); - name = PAD_COMPNAME_PV(kid->op_targ); /* SvCUR of a pad namesv can't be trusted * (see PL_generation), so calc its length @@ -5108,9 +5197,51 @@ Perl_ck_fun(pTHX_ OP *o) else if (kid->op_type == OP_AELEM || kid->op_type == OP_HELEM) { - name = "__ANONIO__"; - len = 10; - mod(kid,type); + OP *op; + + name = 0; + if ((op = ((BINOP*)kid)->op_first)) { + SV *tmpstr = Nullsv; + char *a = + kid->op_type == OP_AELEM ? + "[]" : "{}"; + if (((op->op_type == OP_RV2AV) || + (op->op_type == OP_RV2HV)) && + (op = ((UNOP*)op)->op_first) && + (op->op_type == OP_GV)) { + /* packagevar $a[] or $h{} */ + GV *gv = cGVOPx_gv(op); + if (gv) + tmpstr = + Perl_newSVpvf(aTHX_ + "%s%c...%c", + GvNAME(gv), + a[0], a[1]); + } + else if (op->op_type == OP_PADAV + || op->op_type == OP_PADHV) { + /* lexicalvar $a[] or $h{} */ + char *padname = + PAD_COMPNAME_PV(op->op_targ); + if (padname) + tmpstr = + Perl_newSVpvf(aTHX_ + "%s%c...%c", + padname + 1, + a[0], a[1]); + + } + if (tmpstr) { + name = savepv(SvPVX(tmpstr)); + len = strlen(name); + sv_2mortal(tmpstr); + } + } + if (!name) { + name = "__ANONIO__"; + len = 10; + } + mod(kid, type); } if (name) { SV *namesv; @@ -5457,6 +5588,25 @@ Perl_ck_open(pTHX_ OP *o) } if (o->op_type == OP_BACKTICK) return o; + { + /* In case of three-arg dup open remove strictness + * from the last arg if it is a bareword. */ + OP *first = cLISTOPx(o)->op_first; /* The pushmark. */ + OP *last = cLISTOPx(o)->op_last; /* The bareword. */ + OP *oa; + char *mode; + + if ((last->op_type == OP_CONST) && /* The bareword. */ + (last->op_private & OPpCONST_BARE) && + (last->op_private & OPpCONST_STRICT) && + (oa = first->op_sibling) && /* The fh. */ + (oa = oa->op_sibling) && /* The mode. */ + SvPOK(((SVOP*)oa)->op_sv) && + (mode = SvPVX(((SVOP*)oa)->op_sv)) && + mode[0] == '>' && mode[1] == '&' && /* A dup open. */ + (last == oa->op_sibling)) /* The bareword. */ + last->op_private &= ~OPpCONST_STRICT; + } return ck_fun(o); }