diff options
author | Nicholas Clark <nick@ccl4.org> | 2008-02-12 13:15:20 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2008-02-12 13:15:20 +0000 |
commit | 7918f24d20384771923d344a382e1d16d9552018 (patch) | |
tree | 627e24f3c520f70ddfd3fc9779420bd72fd00c55 /op.c | |
parent | 9f10164a6c9d93684fedbbc188fb9dfe004c22c4 (diff) | |
download | perl-7918f24d20384771923d344a382e1d16d9552018.tar.gz |
assert() that every NN argument is not NULL. Otherwise we have the
ability to create landmines that will explode under someone in the
future when they upgrade their compiler to one with better
optimisation. We've already done this at least twice.
(Yes, some of the assertions are after code that would already have
SEGVd because it already deferences a pointer, but they are put in
to make it easier to automate checking that each and every case is
covered.)
Add a tool, checkARGS_ASSERT.pl, to check that every case is covered.
p4raw-id: //depot/perl@33291
Diffstat (limited to 'op.c')
-rw-r--r-- | op.c | 259 |
1 files changed, 256 insertions, 3 deletions
@@ -210,6 +210,9 @@ S_Slab_to_rw(pTHX_ void *op) { I32 * const * const ptr = (I32 **) op; I32 * const slab = ptr[-1]; + + PERL_ARGS_ASSERT_SLAB_TO_RW; + assert( ptr-1 > (I32 **) slab ); assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) ); assert( *slab > 0 ); @@ -233,6 +236,7 @@ Perl_op_refcnt_inc(pTHX_ OP *o) PADOFFSET Perl_op_refcnt_dec(pTHX_ OP *o) { + PERL_ARGS_ASSERT_OP_REFCNT_DEC; Slab_to_rw(o); return --o->op_targ; } @@ -245,6 +249,7 @@ Perl_Slab_Free(pTHX_ void *op) { I32 * const * const ptr = (I32 **) op; I32 * const slab = ptr[-1]; + PERL_ARGS_ASSERT_SLAB_FREE; assert( ptr-1 > (I32 **) slab ); assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) ); assert( *slab > 0 ); @@ -304,6 +309,9 @@ STATIC const char* S_gv_ename(pTHX_ GV *gv) { SV* const tmpsv = sv_newmortal(); + + PERL_ARGS_ASSERT_GV_ENAME; + gv_efullname3(tmpsv, gv, NULL); return SvPV_nolen_const(tmpsv); } @@ -311,6 +319,8 @@ S_gv_ename(pTHX_ GV *gv) STATIC OP * S_no_fh_allowed(pTHX_ OP *o) { + PERL_ARGS_ASSERT_NO_FH_ALLOWED; + yyerror(Perl_form(aTHX_ "Missing comma after first argument to %s function", OP_DESC(o))); return o; @@ -319,6 +329,8 @@ S_no_fh_allowed(pTHX_ OP *o) STATIC OP * S_too_few_arguments(pTHX_ OP *o, const char *name) { + PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS; + yyerror(Perl_form(aTHX_ "Not enough arguments for %s", name)); return o; } @@ -326,6 +338,8 @@ S_too_few_arguments(pTHX_ OP *o, const char *name) STATIC OP * S_too_many_arguments(pTHX_ OP *o, const char *name) { + PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS; + yyerror(Perl_form(aTHX_ "Too many arguments for %s", name)); return o; } @@ -333,6 +347,8 @@ S_too_many_arguments(pTHX_ OP *o, const char *name) STATIC void S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid) { + PERL_ARGS_ASSERT_BAD_TYPE; + yyerror(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)", (int)n, name, t, OP_DESC(kid))); } @@ -340,6 +356,8 @@ S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid) STATIC void S_no_bareword_allowed(pTHX_ const OP *o) { + PERL_ARGS_ASSERT_NO_BAREWORD_ALLOWED; + if (PL_madskills) return; /* various ok barewords are hidden in extra OP_NULL */ qerror(Perl_mess(aTHX_ @@ -356,6 +374,8 @@ Perl_allocmy(pTHX_ const char *const name) PADOFFSET off; const bool is_our = (PL_parser->in_my == KEY_our); + PERL_ARGS_ASSERT_ALLOCMY; + /* complain about "my $<special_var>" etc etc */ if (*name && !(is_our || @@ -506,6 +526,9 @@ Perl_op_clear(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_OP_CLEAR; + #ifdef PERL_MAD /* if (o->op_madprop && o->op_madprop->mad_next) abort(); */ @@ -646,6 +669,8 @@ clear_pmop: STATIC void S_cop_free(pTHX_ COP* cop) { + PERL_ARGS_ASSERT_COP_FREE; + CopLABEL_free(cop); CopFILE_free(cop); CopSTASH_free(cop); @@ -662,6 +687,9 @@ S_forget_pmop(pTHX_ PMOP *const o ) { HV * const pmstash = PmopSTASH(o); + + PERL_ARGS_ASSERT_FORGET_PMOP; + if (pmstash && !SvIS_FREED(pmstash)) { MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab); if (mg) { @@ -697,6 +725,8 @@ S_forget_pmop(pTHX_ PMOP *const o STATIC void S_find_and_forget_pmops(pTHX_ OP *o) { + PERL_ARGS_ASSERT_FIND_AND_FORGET_PMOPS; + if (o->op_flags & OPf_KIDS) { OP *kid = cUNOPo->op_first; while (kid) { @@ -717,6 +747,9 @@ void Perl_op_null(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_OP_NULL; + if (o->op_type == OP_NULL) return; if (!PL_madskills) @@ -751,6 +784,8 @@ Perl_linklist(pTHX_ OP *o) { OP *first; + PERL_ARGS_ASSERT_LINKLIST; + if (o->op_next) return o->op_next; @@ -791,6 +826,9 @@ STATIC OP * S_scalarboolean(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_SCALARBOOLEAN; + if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) { if (ckWARN(WARN_SYNTAX)) { const line_t oldline = CopLINE(PL_curcop); @@ -885,6 +923,8 @@ Perl_scalarvoid(pTHX_ OP *o) SV* sv; U8 want; + PERL_ARGS_ASSERT_SCALARVOID; + /* trailing mad null ops don't count as "there" for void processing */ if (PL_madskills && o->op_type != OP_NULL && @@ -1627,6 +1667,8 @@ Perl_mod(pTHX_ OP *o, I32 type) STATIC bool S_scalar_mod_type(const OP *o, I32 type) { + PERL_ARGS_ASSERT_SCALAR_MOD_TYPE; + switch (type) { case OP_SASSIGN: if (o->op_type == OP_RV2GV) @@ -1675,6 +1717,8 @@ S_scalar_mod_type(const OP *o, I32 type) STATIC bool S_is_handle_constructor(const OP *o, I32 numargs) { + PERL_ARGS_ASSERT_IS_HANDLE_CONSTRUCTOR; + switch (o->op_type) { case OP_PIPE_OP: case OP_SOCKPAIR: @@ -1712,6 +1756,8 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref) dVAR; OP *kid; + PERL_ARGS_ASSERT_DOREF; + if (!o || (PL_parser && PL_parser->error_count)) return o; @@ -1803,6 +1849,8 @@ S_dup_attrlist(pTHX_ OP *o) dVAR; OP *rop; + PERL_ARGS_ASSERT_DUP_ATTRLIST; + /* An attrlist is either a simple OP_CONST or an OP_LIST with kids, * where the first kid is OP_PUSHMARK and the remaining ones * are OP_CONST. We need to push the OP_CONST values. @@ -1832,6 +1880,8 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) dVAR; SV *stashsv; + PERL_ARGS_ASSERT_APPLY_ATTRS; + /* fake up C<use attributes $pkg,$rv,@attrs> */ ENTER; /* need to protect against side-effects of 'use' */ stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no; @@ -1869,6 +1919,8 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp) OP *pack, *imop, *arg; SV *meth, *stashsv; + PERL_ARGS_ASSERT_APPLY_ATTRS_MY; + if (!attrs) return; @@ -1929,6 +1981,8 @@ Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv, { OP *attrs = NULL; + PERL_ARGS_ASSERT_APPLY_ATTRS_STRING; + if (!len) { len = strlen(attrstr); } @@ -1960,6 +2014,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) dVAR; I32 type; + PERL_ARGS_ASSERT_MY_KID; + if (!o || (PL_parser && PL_parser->error_count)) return o; @@ -2039,6 +2095,8 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs) OP *rops; int maybe_scalar = 0; + PERL_ARGS_ASSERT_MY_ATTRS; + /* [perl #17376]: this appears to be premature, and results in code such as C< our(%x); > executing in list mode rather than void mode */ #if 0 @@ -2069,6 +2127,8 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs) OP * Perl_my(pTHX_ OP *o) { + PERL_ARGS_ASSERT_MY; + return my_attrs(o, NULL); } @@ -2089,6 +2149,8 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) const OPCODE ltype = left->op_type; const OPCODE rtype = right->op_type; + PERL_ARGS_ASSERT_BIND_MATCH; + if ( (ltype == OP_RV2AV || ltype == OP_RV2HV || ltype == OP_PADAV || ltype == OP_PADHV) && ckWARN(WARN_MISC)) { @@ -2224,6 +2286,9 @@ void Perl_newPROG(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_NEWPROG; + if (PL_in_eval) { if (PL_eval_root) return; @@ -2271,6 +2336,9 @@ OP * Perl_localize(pTHX_ OP *o, I32 lex) { dVAR; + + PERL_ARGS_ASSERT_LOCALIZE; + if (o->op_flags & OPf_PARENS) /* [perl #17376]: this appears to be premature, and results in code such as C< our(%x); > executing in list mode rather than void mode */ @@ -2329,6 +2397,8 @@ Perl_localize(pTHX_ OP *o, I32 lex) OP * Perl_jmaybe(pTHX_ OP *o) { + PERL_ARGS_ASSERT_JMAYBE; + if (o->op_type == OP_LIST) { OP * const o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, SVt_PV))); @@ -2352,6 +2422,8 @@ Perl_fold_constants(pTHX_ register OP *o) SV * const olddiehook = PL_diehook; dJMPENV; + PERL_ARGS_ASSERT_FOLD_CONSTANTS; + if (PL_opargs[type] & OA_RETSCALAR) scalar(o); if (PL_opargs[type] & OA_TARGET && !o->op_targ) @@ -2644,6 +2716,8 @@ Perl_newTOKEN(pTHX_ I32 optype, YYSTYPE lval, MADPROP* madprop) void Perl_token_free(pTHX_ TOKEN* tk) { + PERL_ARGS_ASSERT_TOKEN_FREE; + if (tk->tk_type != 12345) return; mad_free(tk->tk_mad); @@ -2655,6 +2729,9 @@ Perl_token_getmad(pTHX_ TOKEN* tk, OP* o, char slot) { MADPROP* mp; MADPROP* tm; + + PERL_ARGS_ASSERT_TOKEN_GETMAD; + if (tk->tk_type != 12345) { Perl_warner(aTHX_ packWARN(WARN_MISC), "Invalid TOKEN object ignored"); @@ -2818,6 +2895,8 @@ Perl_addmad(pTHX_ MADPROP* tm, MADPROP** root, char slot) MADPROP * Perl_newMADsv(pTHX_ char key, SV* sv) { + PERL_ARGS_ASSERT_NEWMADSV; + return newMADPROP(key, MAD_SV, sv, 0); } @@ -3035,6 +3114,9 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) const I32 squash = o->op_private & OPpTRANS_SQUASH; I32 del = o->op_private & OPpTRANS_DELETE; SV* swash; + + PERL_ARGS_ASSERT_PMTRANS; + PL_hints |= HINT_BLOCK_SCOPE; if (SvUTF8(tstr)) @@ -3411,6 +3493,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg) OP* repl = NULL; bool reglist; + PERL_ARGS_ASSERT_PMRUNTIME; + if (o->op_type == OP_SUBST || o->op_type == OP_TRANS) { /* last element in list is the replacement; pop it */ OP* kid; @@ -3590,6 +3674,9 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv) { dVAR; SVOP *svop; + + PERL_ARGS_ASSERT_NEWSVOP; + NewOp(1101, svop, 1, SVOP); svop->op_type = (OPCODE)type; svop->op_ppaddr = PL_ppaddr[type]; @@ -3609,6 +3696,9 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv) { dVAR; PADOP *padop; + + PERL_ARGS_ASSERT_NEWPADOP; + NewOp(1101, padop, 1, PADOP); padop->op_type = (OPCODE)type; padop->op_ppaddr = PL_ppaddr[type]; @@ -3631,7 +3721,9 @@ OP * Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv) { dVAR; - assert(gv); + + PERL_ARGS_ASSERT_NEWGVOP; + #ifdef USE_ITHREADS GvIN_PAD_on(gv); return newPADOP(type, flags, SvREFCNT_inc_simple_NN(gv)); @@ -3671,6 +3763,8 @@ Perl_package(pTHX_ OP *o) OP *pegop; #endif + PERL_ARGS_ASSERT_PACKAGE; + save_hptr(&PL_curstash); save_item(PL_curstname); @@ -3711,6 +3805,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) OP *pegop = newOP(OP_NULL,0); #endif + PERL_ARGS_ASSERT_UTILIZE; + if (idop->op_type != OP_CONST) Perl_croak(aTHX_ "Module name must be constant"); @@ -3838,6 +3934,9 @@ void Perl_load_module(pTHX_ U32 flags, SV *name, SV *ver, ...) { va_list args; + + PERL_ARGS_ASSERT_LOAD_MODULE; + va_start(args, ver); vload_module(flags, name, ver, &args); va_end(args); @@ -3849,6 +3948,7 @@ Perl_load_module_nocontext(U32 flags, SV *name, SV *ver, ...) { dTHX; va_list args; + PERL_ARGS_ASSERT_LOAD_MODULE_NOCONTEXT; va_start(args, ver); vload_module(flags, name, ver, &args); va_end(args); @@ -3860,8 +3960,10 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) { dVAR; OP *veop, *imop; - OP * const modname = newSVOP(OP_CONST, 0, name); + + PERL_ARGS_ASSERT_VLOAD_MODULE; + modname->op_private |= OPpCONST_BARE; if (ver) { veop = newSVOP(OP_CONST, 0, ver); @@ -3905,6 +4007,8 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin) OP *doop; GV *gv = NULL; + PERL_ARGS_ASSERT_DOFILE; + if (!force_builtin) { gv = gv_fetchpvs("do", GV_NOTQUAL, SVt_PVCV); if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) { @@ -4295,6 +4399,9 @@ OP * Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other) { dVAR; + + PERL_ARGS_ASSERT_NEWLOGOP; + return new_logop(type, flags, &first, &other); } @@ -4307,6 +4414,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) OP *first = *firstp; OP * const other = *otherp; + PERL_ARGS_ASSERT_NEW_LOGOP; + if (type == OP_XOR) /* Not short circuit, but here by precedence. */ return newBINOP(type, flags, scalar(first), scalar(other)); @@ -4457,6 +4566,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) OP *start; OP *o; + PERL_ARGS_ASSERT_NEWCONDOP; + if (!falseop) return newLOGOP(OP_AND, 0, first, trueop); if (!trueop) @@ -4519,6 +4630,8 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right) OP *leftstart; OP *o; + PERL_ARGS_ASSERT_NEWRANGE; + NewOp(1101, range, 1, LOGOP); range->op_type = OP_RANGE; @@ -4730,6 +4843,8 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP I32 iterpflags = 0; OP *madsv = NULL; + PERL_ARGS_ASSERT_NEWFOROP; + if (sv) { if (sv->op_type == OP_RV2SV) { /* symbol table variable */ iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */ @@ -4849,6 +4964,8 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label) dVAR; OP *o; + PERL_ARGS_ASSERT_NEWLOOPEX; + if (type != OP_GOTO || label->op_type == OP_CONST) { /* "last()" means "last" */ if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS)) @@ -4913,6 +5030,8 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block, LOGOP *enterop; OP *o; + PERL_ARGS_ASSERT_NEWGIVWHENOP; + NewOp(1101, enterop, 1, LOGOP); enterop->op_type = enter_opcode; enterop->op_ppaddr = PL_ppaddr[enter_opcode]; @@ -4962,6 +5081,9 @@ STATIC bool S_looks_like_bool(pTHX_ const OP *o) { dVAR; + + PERL_ARGS_ASSERT_LOOKS_LIKE_BOOL; + switch(o->op_type) { case OP_OR: return looks_like_bool(cLOGOPo->op_first); @@ -5023,7 +5145,7 @@ OP * Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off) { dVAR; - assert( cond ); + PERL_ARGS_ASSERT_NEWGIVENOP; return newGIVWHENOP( ref_array_or_hash(cond), block, @@ -5038,6 +5160,8 @@ Perl_newWHENOP(pTHX_ OP *cond, OP *block) const bool cond_llb = (!cond || looks_like_bool(cond)); OP *cond_op; + PERL_ARGS_ASSERT_NEWWHENOP; + if (cond_llb) cond_op = cond; else { @@ -5068,6 +5192,8 @@ Perl_cv_undef(pTHX_ CV *cv) { dVAR; + PERL_ARGS_ASSERT_CV_UNDEF; + DEBUG_X(PerlIO_printf(Perl_debug_log, "CV undef: cv=0x%"UVxf" comppad=0x%"UVxf"\n", PTR2UV(cv), PTR2UV(PL_comppad)) @@ -5119,6 +5245,8 @@ void Perl_cv_ckproto_len(pTHX_ const CV *cv, const GV *gv, const char *p, const STRLEN len) { + PERL_ARGS_ASSERT_CV_CKPROTO_LEN; + /* Can't just use a strcmp on the prototype, as CONSTSUBs "cheat" by relying on SvCUR, and doubling up the buffer to hold CvFILE(). */ if (((!p != !SvPOK(cv)) /* One has prototype, one has not. */ @@ -5652,6 +5780,8 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv, const char *const colon = strrchr(fullname,':'); const char *const name = colon ? colon + 1 : fullname; + PERL_ARGS_ASSERT_PROCESS_SPECIAL_BLOCKS; + if (*name == 'B') { if (strEQ(name, "BEGIN")) { const I32 oldscope = PL_scopestack_ix; @@ -5780,6 +5910,8 @@ Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr, { CV *cv = newXS(name, subaddr, filename); + PERL_ARGS_ASSERT_NEWXS_FLAGS; + if (flags & XS_DYNAMIC_FILENAME) { /* We need to "make arrangements" (ie cheat) to ensure that the filename lasts as long as the PVCV we just created, but also doesn't @@ -5836,6 +5968,8 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename) GV_ADDMULTI, SVt_PVCV); register CV *cv; + PERL_ARGS_ASSERT_NEWXS; + if (!subaddr) Perl_croak(aTHX_ "panic: no address for '%s' in '%s'", name, filename); @@ -5989,6 +6123,9 @@ OP * Perl_oopsAV(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_OOPSAV; + switch (o->op_type) { case OP_PADSV: o->op_type = OP_PADAV; @@ -6013,6 +6150,9 @@ OP * Perl_oopsHV(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_OOPSHV; + switch (o->op_type) { case OP_PADSV: case OP_PADAV: @@ -6039,6 +6179,9 @@ OP * Perl_newAVREF(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_NEWAVREF; + if (o->op_type == OP_PADANY) { o->op_type = OP_PADAV; o->op_ppaddr = PL_ppaddr[OP_PADAV]; @@ -6064,6 +6207,9 @@ OP * Perl_newHVREF(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_NEWHVREF; + if (o->op_type == OP_PADANY) { o->op_type = OP_PADHV; o->op_ppaddr = PL_ppaddr[OP_PADHV]; @@ -6087,6 +6233,9 @@ OP * Perl_newSVREF(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_NEWSVREF; + if (o->op_type == OP_PADANY) { o->op_type = OP_PADSV; o->op_ppaddr = PL_ppaddr[OP_PADSV]; @@ -6101,6 +6250,8 @@ Perl_newSVREF(pTHX_ OP *o) OP * Perl_ck_anoncode(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_ANONCODE; + cSVOPo->op_targ = pad_add_anon(cSVOPo->op_sv, o->op_type); if (!PL_madskills) cSVOPo->op_sv = NULL; @@ -6111,6 +6262,9 @@ OP * Perl_ck_bitop(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_CK_BITOP; + #define OP_IS_NUMCOMPARE(op) \ ((op) == OP_LT || (op) == OP_I_LT || \ (op) == OP_GT || (op) == OP_I_GT || \ @@ -6145,7 +6299,10 @@ OP * Perl_ck_concat(pTHX_ OP *o) { const OP * const kid = cUNOPo->op_first; + + PERL_ARGS_ASSERT_CK_CONCAT; PERL_UNUSED_CONTEXT; + if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) && !(kUNOP->op_first->op_flags & OPf_MOD)) o->op_flags |= OPf_STACKED; @@ -6156,6 +6313,9 @@ OP * Perl_ck_spair(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_CK_SPAIR; + if (o->op_flags & OPf_KIDS) { OP* newop; OP* kid; @@ -6184,6 +6344,8 @@ Perl_ck_spair(pTHX_ OP *o) OP * Perl_ck_delete(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_DELETE; + o = ck_fun(o); o->op_private = 0; if (o->op_flags & OPf_KIDS) { @@ -6212,6 +6374,8 @@ Perl_ck_delete(pTHX_ OP *o) OP * Perl_ck_die(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_DIE; + #ifdef VMS if (VMSISH_HUSHED) o->op_private |= OPpHUSH_VMSISH; #endif @@ -6223,6 +6387,8 @@ Perl_ck_eof(pTHX_ OP *o) { dVAR; + PERL_ARGS_ASSERT_CK_EOF; + if (o->op_flags & OPf_KIDS) { if (cLISTOPo->op_first->op_type == OP_STUB) { OP * const newop @@ -6243,6 +6409,9 @@ OP * Perl_ck_eval(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_CK_EVAL; + PL_hints |= HINT_BLOCK_SCOPE; if (o->op_flags & OPf_KIDS) { SVOP * const kid = (SVOP*)cUNOPo->op_first; @@ -6308,6 +6477,8 @@ Perl_ck_eval(pTHX_ OP *o) OP * Perl_ck_exit(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_EXIT; + #ifdef VMS HV * const table = GvHV(PL_hintgv); if (table) { @@ -6323,6 +6494,8 @@ Perl_ck_exit(pTHX_ OP *o) OP * Perl_ck_exec(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_EXEC; + if (o->op_flags & OPf_STACKED) { OP *kid; o = ck_fun(o); @@ -6339,6 +6512,9 @@ OP * Perl_ck_exists(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_CK_EXISTS; + o = ck_fun(o); if (o->op_flags & OPf_KIDS) { OP * const kid = cUNOPo->op_first; @@ -6366,6 +6542,8 @@ Perl_ck_rvconst(pTHX_ register OP *o) dVAR; SVOP * const kid = (SVOP*)cUNOPo->op_first; + PERL_ARGS_ASSERT_CK_RVCONST; + o->op_private |= (PL_hints & HINT_STRICT_REFS); if (o->op_type == OP_RV2CV) o->op_private &= ~1; @@ -6482,6 +6660,8 @@ Perl_ck_ftst(pTHX_ OP *o) dVAR; const I32 type = o->op_type; + PERL_ARGS_ASSERT_CK_FTST; + if (o->op_flags & OPf_REF) { NOOP; } @@ -6527,6 +6707,8 @@ Perl_ck_fun(pTHX_ OP *o) const int type = o->op_type; register I32 oa = PL_opargs[type] >> OASHIFT; + PERL_ARGS_ASSERT_CK_FUN; + if (o->op_flags & OPf_STACKED) { if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL)) oa &= ~OA_OPTIONAL; @@ -6802,6 +6984,8 @@ Perl_ck_glob(pTHX_ OP *o) dVAR; GV *gv; + PERL_ARGS_ASSERT_CK_GLOB; + o = ck_fun(o); if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling) append_elem(OP_GLOB, o, newDEFSVOP()); @@ -6860,6 +7044,8 @@ Perl_ck_grep(pTHX_ OP *o) const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE; PADOFFSET offset; + PERL_ARGS_ASSERT_CK_GREP; + o->op_ppaddr = PL_ppaddr[OP_GREPSTART]; /* don't allocate gwop here, as we may leak it if PL_parser->error_count > 0 */ @@ -6919,6 +7105,8 @@ Perl_ck_grep(pTHX_ OP *o) OP * Perl_ck_index(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_INDEX; + if (o->op_flags & OPf_KIDS) { OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ if (kid) @@ -6932,6 +7120,8 @@ Perl_ck_index(pTHX_ OP *o) OP * Perl_ck_lengthconst(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_LENGTHCONST; + /* XXX length optimization goes here */ return ck_fun(o); } @@ -6940,12 +7130,17 @@ OP * Perl_ck_lfun(pTHX_ OP *o) { const OPCODE type = o->op_type; + + PERL_ARGS_ASSERT_CK_LFUN; + return modkids(ck_fun(o), type); } OP * Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ { + PERL_ARGS_ASSERT_CK_DEFINED; + if ((o->op_flags & OPf_KIDS) && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) { switch (cUNOPo->op_first->op_type) { case OP_RV2AV: @@ -6984,6 +7179,8 @@ Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ OP * Perl_ck_readline(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_READLINE; + if (!(o->op_flags & OPf_KIDS)) { OP * const newop = newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, PL_argvgv)); @@ -7001,6 +7198,9 @@ OP * Perl_ck_rfun(pTHX_ OP *o) { const OPCODE type = o->op_type; + + PERL_ARGS_ASSERT_CK_RFUN; + return refkids(ck_fun(o), type); } @@ -7009,6 +7209,8 @@ Perl_ck_listiob(pTHX_ OP *o) { register OP *kid; + PERL_ARGS_ASSERT_CK_LISTIOB; + kid = cLISTOPo->op_first; if (!kid) { o = force_list(o); @@ -7067,6 +7269,9 @@ Perl_ck_sassign(pTHX_ OP *o) { dVAR; OP * const kid = cLISTOPo->op_first; + + PERL_ARGS_ASSERT_CK_SASSIGN; + /* has a disposable target? */ if ((PL_opargs[kid->op_type] & OA_TARGLEX) && !(kid->op_flags & OPf_STACKED) @@ -7128,6 +7333,9 @@ OP * Perl_ck_match(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_CK_MATCH; + if (o->op_type != OP_QR && PL_compcv) { const PADOFFSET offset = pad_findmy("$_"); if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS_isOUR(offset))) { @@ -7144,6 +7352,9 @@ OP * Perl_ck_method(pTHX_ OP *o) { OP * const kid = cUNOPo->op_first; + + PERL_ARGS_ASSERT_CK_METHOD; + if (kid->op_type == OP_CONST) { SV* sv = kSVOP->op_sv; const char * const method = SvPVX_const(sv); @@ -7170,6 +7381,7 @@ Perl_ck_method(pTHX_ OP *o) OP * Perl_ck_null(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_NULL; PERL_UNUSED_CONTEXT; return o; } @@ -7179,6 +7391,9 @@ Perl_ck_open(pTHX_ OP *o) { dVAR; HV * const table = GvHV(PL_hintgv); + + PERL_ARGS_ASSERT_CK_OPEN; + if (table) { SV **svp = hv_fetchs(table, "open_IN", FALSE); if (svp && *svp) { @@ -7236,6 +7451,8 @@ Perl_ck_open(pTHX_ OP *o) OP * Perl_ck_repeat(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_REPEAT; + if (cBINOPo->op_first->op_flags & OPf_PARENS) { o->op_private |= OPpREPEAT_DOLIST; cBINOPo->op_first = force_list(cBINOPo->op_first); @@ -7251,6 +7468,8 @@ Perl_ck_require(pTHX_ OP *o) dVAR; GV* gv = NULL; + PERL_ARGS_ASSERT_CK_REQUIRE; + if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */ SVOP * const kid = (SVOP*)cUNOPo->op_first; @@ -7320,6 +7539,9 @@ OP * Perl_ck_return(pTHX_ OP *o) { dVAR; + + PERL_ARGS_ASSERT_CK_RETURN; + if (CvLVALUE(PL_compcv)) { OP *kid; for (kid = cLISTOPo->op_first->op_sibling; kid; kid = kid->op_sibling) @@ -7333,6 +7555,9 @@ Perl_ck_select(pTHX_ OP *o) { dVAR; OP* kid; + + PERL_ARGS_ASSERT_CK_SELECT; + if (o->op_flags & OPf_KIDS) { kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ if (kid && kid->op_sibling) { @@ -7355,6 +7580,8 @@ Perl_ck_shift(pTHX_ OP *o) dVAR; const I32 type = o->op_type; + PERL_ARGS_ASSERT_CK_SHIFT; + if (!(o->op_flags & OPf_KIDS)) { OP *argop; /* FIXME - this can be refactored to reduce code in #ifdefs */ @@ -7382,6 +7609,8 @@ Perl_ck_sort(pTHX_ OP *o) dVAR; OP *firstkid; + PERL_ARGS_ASSERT_CK_SORT; + if (o->op_type == OP_SORT && (PL_hints & HINT_LOCALIZE_HH) != 0) { HV * const hinthv = GvHV(PL_hintgv); if (hinthv) { @@ -7463,6 +7692,9 @@ S_simplify_sort(pTHX_ OP *o) int descending; GV *gv; const char *gvname; + + PERL_ARGS_ASSERT_SIMPLIFY_SORT; + if (!(o->op_flags & OPf_STACKED)) return; GvMULTI_on(gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV)); @@ -7534,6 +7766,8 @@ Perl_ck_split(pTHX_ OP *o) dVAR; register OP *kid; + PERL_ARGS_ASSERT_CK_SPLIT; + if (o->op_flags & OPf_STACKED) return no_fh_allowed(o); @@ -7589,6 +7823,9 @@ OP * Perl_ck_join(pTHX_ OP *o) { const OP * const kid = cLISTOPo->op_first->op_sibling; + + PERL_ARGS_ASSERT_CK_JOIN; + if (kid && kid->op_type == OP_MATCH) { if (ckWARN(WARN_SYNTAX)) { const REGEXP *re = PM_GETRE(kPMOP); @@ -7620,6 +7857,8 @@ Perl_ck_subr(pTHX_ OP *o) const char *e = NULL; bool delete_op = 0; + PERL_ARGS_ASSERT_CK_SUBR; + o->op_private |= OPpENTERSUB_HASTARG; for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ; if (cvop->op_type == OP_RV2CV) { @@ -7859,6 +8098,7 @@ Perl_ck_subr(pTHX_ OP *o) OP * Perl_ck_svconst(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_SVCONST; PERL_UNUSED_CONTEXT; SvREADONLY_on(cSVOPo->op_sv); return o; @@ -7883,6 +8123,8 @@ Perl_ck_chdir(pTHX_ OP *o) OP * Perl_ck_trunc(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_TRUNC; + if (o->op_flags & OPf_KIDS) { SVOP *kid = (SVOP*)cUNOPo->op_first; @@ -7902,6 +8144,9 @@ OP * Perl_ck_unpack(pTHX_ OP *o) { OP *kid = cLISTOPo->op_first; + + PERL_ARGS_ASSERT_CK_UNPACK; + if (kid->op_sibling) { kid = kid->op_sibling; if (!kid->op_sibling) @@ -7913,6 +8158,8 @@ Perl_ck_unpack(pTHX_ OP *o) OP * Perl_ck_substr(pTHX_ OP *o) { + PERL_ARGS_ASSERT_CK_SUBSTR; + o = ck_fun(o); if ((o->op_flags & OPf_KIDS) && (o->op_private == 4)) { OP *kid = cLISTOPo->op_first; @@ -7932,6 +8179,8 @@ Perl_ck_each(pTHX_ OP *o) dVAR; OP *kid = cLISTOPo->op_first; + PERL_ARGS_ASSERT_CK_EACH; + if (kid->op_type == OP_PADAV || kid->op_type == OP_RV2AV) { const unsigned new_type = o->op_type == OP_EACH ? OP_AEACH : o->op_type == OP_KEYS ? OP_AKEYS : OP_AVALUES; @@ -8564,6 +8813,8 @@ Perl_custom_op_name(pTHX_ const OP* o) SV* keysv; HE* he; + PERL_ARGS_ASSERT_CUSTOM_OP_NAME; + if (!PL_custom_op_names) /* This probably shouldn't happen */ return (char *)PL_op_name[OP_CUSTOM]; @@ -8584,6 +8835,8 @@ Perl_custom_op_desc(pTHX_ const OP* o) SV* keysv; HE* he; + PERL_ARGS_ASSERT_CUSTOM_OP_DESC; + if (!PL_custom_op_descs) return (char *)PL_op_desc[OP_CUSTOM]; |