X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/978a498e17ec54b6f1fc65f3375a62a68f321f99..46391258eca955edb5120d04f4c8fc6a1b087124:/op.c diff --git a/op.c b/op.c index c95c8ea..2b83188 100644 --- a/op.c +++ b/op.c @@ -578,6 +578,13 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags) PL_parser->in_my == KEY_state ? "state" : "my"), flags & SVf_UTF8); } } + else if (len == 2 && name[1] == '_' && !is_our) + /* diag_listed_as: Use of my $_ is experimental */ + Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__LEXICAL_TOPIC), + "Use of %s $_ is experimental", + PL_parser->in_my == KEY_state + ? "state" + : "my"); /* allocate a spare slot and store the name in that slot */ @@ -647,12 +654,6 @@ S_op_destroy(pTHX_ OP *o) FreeOp(o); } -#ifdef USE_ITHREADS -# define forget_pmop(a,b) S_forget_pmop(aTHX_ a,b) -#else -# define forget_pmop(a,b) S_forget_pmop(aTHX_ a) -#endif - /* Destructor */ void @@ -799,7 +800,7 @@ Perl_op_clear(pTHX_ OP *o) #endif if (still_valid) { int try_downgrade = SvREFCNT(gv) == 2; - SvREFCNT_dec(gv); + SvREFCNT_dec_NN(gv); if (try_downgrade) gv_try_downgrade(gv); } @@ -870,7 +871,7 @@ clear_pmop: if (!(cPMOPo->op_pmflags & PMf_CODELIST_PRIVATE)) op_free(cPMOPo->op_code_list); cPMOPo->op_code_list = NULL; - forget_pmop(cPMOPo, 1); + forget_pmop(cPMOPo); cPMOPo->op_pmreplrootu.op_pmreplroot = NULL; /* we use the same protection as the "SAFE" version of the PM_ macros * here since sv_clean_all might release some PMOPs @@ -913,9 +914,6 @@ S_cop_free(pTHX_ COP* cop) STATIC void S_forget_pmop(pTHX_ PMOP *const o -#ifdef USE_ITHREADS - , U32 flags -#endif ) { HV * const pmstash = PmopSTASH(o); @@ -948,10 +946,6 @@ S_forget_pmop(pTHX_ PMOP *const o } if (PL_curpm == o) PL_curpm = NULL; -#ifdef USE_ITHREADS - if (flags) - PmopSTASH_free(o); -#endif } STATIC void @@ -967,7 +961,7 @@ S_find_and_forget_pmops(pTHX_ OP *o) case OP_PUSHRE: case OP_MATCH: case OP_QR: - forget_pmop((PMOP*)kid, 0); + forget_pmop((PMOP*)kid); } find_and_forget_pmops(kid); kid = kid->op_sibling; @@ -1393,7 +1387,7 @@ Perl_scalarvoid(pTHX_ OP *o) PERL_PV_PRETTY_DUMP | PERL_PV_ESCAPE_NOCLEAR | PERL_PV_ESCAPE_UNI_DETECT)); - SvREFCNT_dec(dsv); + SvREFCNT_dec_NN(dsv); } } else if (SvOK(sv)) { @@ -1809,7 +1803,7 @@ S_finalize_op(pTHX_ OP* o) lexname = newSVpvn_share(key, SvUTF8(sv) ? -(I32)keylen : (I32)keylen, 0); - SvREFCNT_dec(sv); + SvREFCNT_dec_NN(sv); *svp = lexname; } @@ -2077,11 +2071,12 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) /* FALL THROUGH */ case OP_ASLICE: case OP_HSLICE: - if (type == OP_LEAVESUBLV) - o->op_private |= OPpMAYBE_LVSUB; localize = 1; /* FALL THROUGH */ case OP_AASSIGN: + if (type == OP_LEAVESUBLV) + o->op_private |= OPpMAYBE_LVSUB; + /* FALL THROUGH */ case OP_NEXTSTATE: case OP_DBSTATE: PL_modcount = RETURN_UNLIMITED_NUMBER; @@ -3126,10 +3121,10 @@ Perl_localize(pTHX_ OP *o, I32 lex) while (1) { if (*s && strchr("@$%*", *s) && *++s - && (isALNUM(*s) || UTF8_IS_CONTINUED(*s))) { + && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s))) { s++; sigil = TRUE; - while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s))) + while (*s && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s))) s++; while (*s && (strchr(", \t\n", *s))) s++; @@ -4561,16 +4556,16 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor) scalar(o); LINKLIST(o); if (cLISTOPo->op_first->op_type == OP_LEAVE) { - LISTOP *leave = cLISTOPx(cLISTOPo->op_first); + LISTOP *leaveop = cLISTOPx(cLISTOPo->op_first); /* skip ENTER */ - assert(leave->op_first->op_type == OP_ENTER); - assert(leave->op_first->op_sibling); - o->op_next = leave->op_first->op_sibling; - /* skip LEAVE */ - assert(leave->op_flags & OPf_KIDS); - assert(leave->op_last->op_next = (OP*)leave); - leave->op_next = NULL; /* stop on last op */ - op_null((OP*)leave); + assert(leaveop->op_first->op_type == OP_ENTER); + assert(leaveop->op_first->op_sibling); + o->op_next = leaveop->op_first->op_sibling; + /* skip leave */ + assert(leaveop->op_flags & OPf_KIDS); + assert(leaveop->op_last->op_next == (OP*)leaveop); + leaveop->op_next = NULL; /* stop on last op */ + op_null((OP*)leaveop); } else { /* skip SCOPE */ @@ -5589,7 +5584,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) = MUTABLE_GV(cSVOPx(tmpop)->op_sv); cSVOPx(tmpop)->op_sv = NULL; /* steal it */ #endif - pm->op_pmflags |= PMf_ONCE; tmpop = cUNOPo->op_first; /* to list (nulled) */ tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */ tmpop->op_sibling = NULL; /* don't free split */ @@ -7293,7 +7287,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) &PadARRAY(PadlistARRAY(CvPADLIST(outcv))[CvDEPTH(outcv)])[pax]; if (reusable) cv_clone_into(clonee, *spot); else *spot = cv_clone(clonee); - SvREFCNT_dec(clonee); + SvREFCNT_dec_NN(clonee); cv = *spot; SvPADMY_on(cv); } @@ -7798,13 +7792,16 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, STRLEN len, PL_curstash = (HV *)SvREFCNT_inc_simple_NN(stash); } + /* Protect sv against leakage caused by fatal warnings. */ + if (sv) SAVEFREESV(sv); + /* file becomes the CvFILE. For an XS, it's usually static storage, and so doesn't get free()d. (It's expected to be from the C pre- processor __FILE__ directive). But we need a dynamically allocated one, and we need it to get freed. */ cv = newXS_len_flags(name, len, const_sv_xsub, file ? file : "", "", &sv, XS_DYNAMIC_FILENAME | flags); - CvXSUBANY(cv).any_ptr = sv; + CvXSUBANY(cv).any_ptr = SvREFCNT_inc_simple(sv); CvCONST_on(cv); LEAVE; @@ -7859,7 +7856,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len, ), cv, const_svp); } - SvREFCNT_dec(cv); + SvREFCNT_dec_NN(cv); cv = NULL; } } @@ -8272,6 +8269,8 @@ Perl_ck_spair(pTHX_ OP *o) #endif kUNOP->op_first = newop; } + /* transforms OP_REFGEN into OP_SREFGEN, OP_CHOP into OP_SCHOP, + * and OP_CHOMP into OP_SCHOMP */ o->op_ppaddr = PL_ppaddr[++o->op_type]; return ck_fun(o); } @@ -8984,12 +8983,10 @@ Perl_ck_glob(pTHX_ OP *o) * \ mark - glob - rv2cv * | \ gv(CORE::GLOBAL::glob) * | - * \ null - const(wildcard) - const(ix) + * \ null - const(wildcard) */ o->op_flags |= OPf_SPECIAL; o->op_targ = pad_alloc(OP_GLOB, SVs_PADTMP); - op_append_elem(OP_GLOB, o, - newSVOP(OP_CONST, 0, newSViv(PL_glob_index++))); o = newLISTOP(OP_LIST, 0, o, NULL); o = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, o, @@ -9011,11 +9008,8 @@ Perl_ck_glob(pTHX_ OP *o) gv = (GV *)newSV(0); gv_init(gv, 0, "", 0, 0); gv_IOadd(gv); -#ifndef PERL_EXTERNAL_GLOB - sv_setiv(GvSVn(gv),PL_glob_index++); -#endif op_append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv)); - SvREFCNT_dec(gv); /* newGVOP increased it */ + SvREFCNT_dec_NN(gv); /* newGVOP increased it */ scalarkids(o); return o; }