summaryrefslogtreecommitdiff
path: root/op.c
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2008-02-12 13:15:20 +0000
committerNicholas Clark <nick@ccl4.org>2008-02-12 13:15:20 +0000
commit7918f24d20384771923d344a382e1d16d9552018 (patch)
tree627e24f3c520f70ddfd3fc9779420bd72fd00c55 /op.c
parent9f10164a6c9d93684fedbbc188fb9dfe004c22c4 (diff)
downloadperl-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.c259
1 files changed, 256 insertions, 3 deletions
diff --git a/op.c b/op.c
index e82e29adc9..f38ce49c49 100644
--- a/op.c
+++ b/op.c
@@ -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];