X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d0761305e645847e893799c475b2a24d15afbcd0..3d04513d447d337fe15b345b1c6a4cf19dfbe89c:/op.c diff --git a/op.c b/op.c index 8efc898..60184b6 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 deprecated */ + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "Use of %s $_ is deprecated", + 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; @@ -3209,7 +3204,7 @@ S_op_integerize(pTHX_ OP *o) } static OP * -S_fold_constants(pTHX_ register OP *o) +S_fold_constants(pTHX_ OP *o) { dVAR; OP * VOL curop; @@ -3359,7 +3354,7 @@ S_fold_constants(pTHX_ register OP *o) } static OP * -S_gen_constant_list(pTHX_ register OP *o) +S_gen_constant_list(pTHX_ OP *o) { dVAR; OP *curop; @@ -5318,7 +5313,7 @@ Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP *listval) } STATIC I32 -S_is_list_assignment(pTHX_ register const OP *o) +S_is_list_assignment(pTHX_ const OP *o) { unsigned type; U8 flags; @@ -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 */ @@ -6412,7 +6406,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) { /* Basically turn for($x..$y) into the same as for($x,$y), but we * set the STACKED flag to indicate that these values are to be - * treated as min/max values by 'pp_iterinit'. + * treated as min/max values by 'pp_enteriter'. */ const UNOP* const flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first; LOGOP* const range = (LOGOP*) flip->op_first; @@ -6979,8 +6973,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) const char *ps; STRLEN ps_len = 0; /* init it to avoid false uninit warning from icc */ U32 ps_utf8 = 0; - register CV *cv = NULL; - register CV *compcv = PL_compcv; + CV *cv = NULL; + CV *compcv = PL_compcv; SV *const_sv; PADNAME *name; PADOFFSET pax = o->op_targ; @@ -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); } @@ -7548,7 +7542,7 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, GvCVGEN(gv) = 0; if (HvENAME_HEK(GvSTASH(gv))) /* sub Foo::bar { (shift)+1 } */ - mro_method_changed_in(GvSTASH(gv)); + gv_method_changed(gv); } } if (!CvGV(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; } } @@ -7872,7 +7869,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len, GvCV_set(gv,cv); GvCVGEN(gv) = 0; if (HvENAME_HEK(GvSTASH(gv))) - mro_method_changed_in(GvSTASH(gv)); /* newXS */ + gv_method_changed(gv); /* newXS */ } } if (!name) @@ -7906,7 +7903,7 @@ Perl_newSTUB(pTHX_ GV *gv, bool fake) GvCV_set(gv, cv); GvCVGEN(gv) = 0; if (!fake && HvENAME_HEK(GvSTASH(gv))) - mro_method_changed_in(GvSTASH(gv)); + gv_method_changed(gv); CvGV_set(cv, gv); CvFILE_set_from_cop(cv, PL_curcop); CvSTASH_set(cv, PL_curstash); @@ -8481,7 +8478,7 @@ Perl_ck_exists(pTHX_ OP *o) } OP * -Perl_ck_rvconst(pTHX_ register OP *o) +Perl_ck_rvconst(pTHX_ OP *o) { dVAR; SVOP * const kid = (SVOP*)cUNOPo->op_first; @@ -8984,12 +8981,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 +9006,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; } @@ -10773,7 +10765,7 @@ S_inplace_aassign(pTHX_ OP *o) { * peep() is called */ void -Perl_rpeep(pTHX_ register OP *o) +Perl_rpeep(pTHX_ OP *o) { dVAR; OP* oldop = NULL; @@ -11506,7 +11498,7 @@ Perl_rpeep(pTHX_ register OP *o) } void -Perl_peep(pTHX_ register OP *o) +Perl_peep(pTHX_ OP *o) { CALL_RPEEP(o); }