return 0;
}
+
+/*
+=for apidoc op_class
+
+Given an op, determine what type of struct it has been allocated as.
+Returns one of the OPclass enums, such as OPclass_LISTOP.
+
+=cut
+*/
+
+
+OPclass
+Perl_op_class(pTHX_ const OP *o)
+{
+ bool custom = 0;
+
+ if (!o)
+ return OPclass_NULL;
+
+ if (o->op_type == 0) {
+ if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
+ return OPclass_COP;
+ return (o->op_flags & OPf_KIDS) ? OPclass_UNOP : OPclass_BASEOP;
+ }
+
+ if (o->op_type == OP_SASSIGN)
+ return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPclass_UNOP : OPclass_BINOP);
+
+ if (o->op_type == OP_AELEMFAST) {
+#ifdef USE_ITHREADS
+ return OPclass_PADOP;
+#else
+ return OPclass_SVOP;
+#endif
+ }
+
+#ifdef USE_ITHREADS
+ if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
+ o->op_type == OP_RCATLINE)
+ return OPclass_PADOP;
+#endif
+
+ if (o->op_type == OP_CUSTOM)
+ custom = 1;
+
+ switch (OP_CLASS(o)) {
+ case OA_BASEOP:
+ return OPclass_BASEOP;
+
+ case OA_UNOP:
+ return OPclass_UNOP;
+
+ case OA_BINOP:
+ return OPclass_BINOP;
+
+ case OA_LOGOP:
+ return OPclass_LOGOP;
+
+ case OA_LISTOP:
+ return OPclass_LISTOP;
+
+ case OA_PMOP:
+ return OPclass_PMOP;
+
+ case OA_SVOP:
+ return OPclass_SVOP;
+
+ case OA_PADOP:
+ return OPclass_PADOP;
+
+ case OA_PVOP_OR_SVOP:
+ /*
+ * Character translations (tr///) are usually a PVOP, keeping a
+ * pointer to a table of shorts used to look up translations.
+ * Under utf8, however, a simple table isn't practical; instead,
+ * the OP is an SVOP (or, under threads, a PADOP),
+ * and the SV is a reference to a swash
+ * (i.e., an RV pointing to an HV).
+ */
+ return (!custom &&
+ (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
+ )
+#if defined(USE_ITHREADS)
+ ? OPclass_PADOP : OPclass_PVOP;
+#else
+ ? OPclass_SVOP : OPclass_PVOP;
+#endif
+
+ case OA_LOOP:
+ return OPclass_LOOP;
+
+ case OA_COP:
+ return OPclass_COP;
+
+ case OA_BASEOP_OR_UNOP:
+ /*
+ * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
+ * whether parens were seen. perly.y uses OPf_SPECIAL to
+ * signal whether a BASEOP had empty parens or none.
+ * Some other UNOPs are created later, though, so the best
+ * test is OPf_KIDS, which is set in newUNOP.
+ */
+ return (o->op_flags & OPf_KIDS) ? OPclass_UNOP : OPclass_BASEOP;
+
+ case OA_FILESTATOP:
+ /*
+ * The file stat OPs are created via UNI(OP_foo) in toke.c but use
+ * the OPf_REF flag to distinguish between OP types instead of the
+ * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
+ * return OPclass_UNOP so that walkoptree can find our children. If
+ * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
+ * (no argument to the operator) it's an OP; with OPf_REF set it's
+ * an SVOP (and op_sv is the GV for the filehandle argument).
+ */
+ return ((o->op_flags & OPf_KIDS) ? OPclass_UNOP :
+#ifdef USE_ITHREADS
+ (o->op_flags & OPf_REF) ? OPclass_PADOP : OPclass_BASEOP);
+#else
+ (o->op_flags & OPf_REF) ? OPclass_SVOP : OPclass_BASEOP);
+#endif
+ case OA_LOOPEXOP:
+ /*
+ * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
+ * label was omitted (in which case it's a BASEOP) or else a term was
+ * seen. In this last case, all except goto are definitely PVOP but
+ * goto is either a PVOP (with an ordinary constant label), an UNOP
+ * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
+ * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
+ * get set.
+ */
+ if (o->op_flags & OPf_STACKED)
+ return OPclass_UNOP;
+ else if (o->op_flags & OPf_SPECIAL)
+ return OPclass_BASEOP;
+ else
+ return OPclass_PVOP;
+ case OA_METHOP:
+ return OPclass_METHOP;
+ case OA_UNOP_AUX:
+ return OPclass_UNOP_AUX;
+ }
+ Perl_warn(aTHX_ "Can't determine class of operator %s, assuming BASEOP\n",
+ OP_NAME(o));
+ return OPclass_BASEOP;
+}
+
+
+
STATIC CV*
S_deb_curcv(pTHX_ I32 ix)
{
Ap |void |dump_eval
Ap |void |dump_form |NN const GV* gv
Ap |void |gv_dump |NULLOK GV* gv
+Apd |OPclass|op_class |NULLOK const OP *o
Ap |void |op_dump |NN const OP *o
Ap |void |pmop_dump |NULLOK PMOP* pm
Ap |void |dump_packsubs |NN const HV* stash
#define nothreadhook() Perl_nothreadhook(aTHX)
#define op_append_elem(a,b,c) Perl_op_append_elem(aTHX_ a,b,c)
#define op_append_list(a,b,c) Perl_op_append_list(aTHX_ a,b,c)
+#define op_class(a) Perl_op_class(aTHX_ a)
#define op_contextualize(a,b) Perl_op_contextualize(aTHX_ a,b)
#define op_convert_list(a,b,c) Perl_op_convert_list(aTHX_ a,b,c)
#define op_dump(a) Perl_op_dump(aTHX_ a)
# walkoptree comes from B.xs
BEGIN {
- $B::VERSION = '1.65';
+ $B::VERSION = '1.66';
@B::EXPORT_OK = ();
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
"B::IO",
};
-typedef enum {
- OPc_NULL, /* 0 */
- OPc_BASEOP, /* 1 */
- OPc_UNOP, /* 2 */
- OPc_BINOP, /* 3 */
- OPc_LOGOP, /* 4 */
- OPc_LISTOP, /* 5 */
- OPc_PMOP, /* 6 */
- OPc_SVOP, /* 7 */
- OPc_PADOP, /* 8 */
- OPc_PVOP, /* 9 */
- OPc_LOOP, /* 10 */
- OPc_COP, /* 11 */
- OPc_METHOP, /* 12 */
- OPc_UNOP_AUX /* 13 */
-} opclass;
static const char* const opclassnames[] = {
"B::NULL",
cxt->x_specialsv_list[6] = (SV *) pWARN_STD;
}
-static opclass
-cc_opclass(pTHX_ const OP *o)
-{
- bool custom = 0;
-
- if (!o)
- return OPc_NULL;
-
- if (o->op_type == 0) {
- if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
- return OPc_COP;
- return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
- }
-
- if (o->op_type == OP_SASSIGN)
- return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
-
- if (o->op_type == OP_AELEMFAST) {
-#ifdef USE_ITHREADS
- return OPc_PADOP;
-#else
- return OPc_SVOP;
-#endif
- }
-
-#ifdef USE_ITHREADS
- if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
- o->op_type == OP_RCATLINE)
- return OPc_PADOP;
-#endif
-
- if (o->op_type == OP_CUSTOM)
- custom = 1;
-
- switch (OP_CLASS(o)) {
- case OA_BASEOP:
- return OPc_BASEOP;
-
- case OA_UNOP:
- return OPc_UNOP;
-
- case OA_BINOP:
- return OPc_BINOP;
-
- case OA_LOGOP:
- return OPc_LOGOP;
-
- case OA_LISTOP:
- return OPc_LISTOP;
-
- case OA_PMOP:
- return OPc_PMOP;
-
- case OA_SVOP:
- return OPc_SVOP;
-
- case OA_PADOP:
- return OPc_PADOP;
-
- case OA_PVOP_OR_SVOP:
- /*
- * Character translations (tr///) are usually a PVOP, keeping a
- * pointer to a table of shorts used to look up translations.
- * Under utf8, however, a simple table isn't practical; instead,
- * the OP is an SVOP (or, under threads, a PADOP),
- * and the SV is a reference to a swash
- * (i.e., an RV pointing to an HV).
- */
- return (!custom &&
- (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
- )
-#if defined(USE_ITHREADS)
- ? OPc_PADOP : OPc_PVOP;
-#else
- ? OPc_SVOP : OPc_PVOP;
-#endif
-
- case OA_LOOP:
- return OPc_LOOP;
-
- case OA_COP:
- return OPc_COP;
-
- case OA_BASEOP_OR_UNOP:
- /*
- * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
- * whether parens were seen. perly.y uses OPf_SPECIAL to
- * signal whether a BASEOP had empty parens or none.
- * Some other UNOPs are created later, though, so the best
- * test is OPf_KIDS, which is set in newUNOP.
- */
- return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
-
- case OA_FILESTATOP:
- /*
- * The file stat OPs are created via UNI(OP_foo) in toke.c but use
- * the OPf_REF flag to distinguish between OP types instead of the
- * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
- * return OPc_UNOP so that walkoptree can find our children. If
- * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
- * (no argument to the operator) it's an OP; with OPf_REF set it's
- * an SVOP (and op_sv is the GV for the filehandle argument).
- */
- return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
-#ifdef USE_ITHREADS
- (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
-#else
- (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
-#endif
- case OA_LOOPEXOP:
- /*
- * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
- * label was omitted (in which case it's a BASEOP) or else a term was
- * seen. In this last case, all except goto are definitely PVOP but
- * goto is either a PVOP (with an ordinary constant label), an UNOP
- * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
- * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
- * get set.
- */
- if (o->op_flags & OPf_STACKED)
- return OPc_UNOP;
- else if (o->op_flags & OPf_SPECIAL)
- return OPc_BASEOP;
- else
- return OPc_PVOP;
- case OA_METHOP:
- return OPc_METHOP;
- case OA_UNOP_AUX:
- return OPc_UNOP_AUX;
- }
- warn("can't determine class of operator %s, assuming BASEOP\n",
- OP_NAME(o));
- return OPc_BASEOP;
-}
static SV *
make_op_object(pTHX_ const OP *o)
{
SV *opsv = sv_newmortal();
- sv_setiv(newSVrv(opsv, opclassnames[cc_opclass(aTHX_ o)]), PTR2IV(o));
+ sv_setiv(newSVrv(opsv, opclassnames[op_class(o)]), PTR2IV(o));
return opsv;
}
dSP;
OP *kid;
SV *object;
- const char *const classname = opclassnames[cc_opclass(aTHX_ o)];
+ const char *const classname = opclassnames[op_class(o)];
dMY_CXT;
/* Check that no-one has changed our reference, or is holding a reference
ref = walkoptree(aTHX_ kid, method, ref);
}
}
- if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_SPLIT
+ if (o && (op_class(o) == OPclass_PMOP) && o->op_type != OP_SPLIT
&& (kid = PMOP_pmreplroot(cPMOPo)))
{
ref = walkoptree(aTHX_ kid, method, ref);
: &PL_sv_undef);
break;
case 26: /* B::OP::size */
- ret = sv_2mortal(newSVuv((UV)(opsizes[cc_opclass(aTHX_ o)])));
+ ret = sv_2mortal(newSVuv((UV)(opsizes[op_class(o)])));
break;
case 27: /* B::OP::name */
case 28: /* B::OP::desc */
#define kLOOP cLOOPx(kid)
+typedef enum {
+ OPclass_NULL, /* 0 */
+ OPclass_BASEOP, /* 1 */
+ OPclass_UNOP, /* 2 */
+ OPclass_BINOP, /* 3 */
+ OPclass_LOGOP, /* 4 */
+ OPclass_LISTOP, /* 5 */
+ OPclass_PMOP, /* 6 */
+ OPclass_SVOP, /* 7 */
+ OPclass_PADOP, /* 8 */
+ OPclass_PVOP, /* 9 */
+ OPclass_LOOP, /* 10 */
+ OPclass_COP, /* 11 */
+ OPclass_METHOP, /* 12 */
+ OPclass_UNOP_AUX /* 13 */
+} OPclass;
+
+
#ifdef USE_ITHREADS
# define cGVOPx_gv(o) ((GV*)PAD_SVl(cPADOPx(o)->op_padix))
# ifndef PERL_CORE
issued on exit from the C<default> block, so you won't get the
error if you use an explicit C<continue>.)
+=item Can't determine class of operator %s, assuming BASEOP
+
+(S) This warning indicates something wrong in the internals of perl.
+Perl was trying to find the class (e.g. LISTOP) of a particular OP,
+and was unable to do so. This is likely to be due to a bug in the perl
+internals, or due to a bug in XS code which manipulates perl optrees.
+
=item Can't do inplace edit: %s is not a regular file
(S inplace) You tried to use the B<-i> switch on a special file, such as
PERL_CALLCONV OP* Perl_op_append_elem(pTHX_ I32 optype, OP* first, OP* last);
PERL_CALLCONV OP* Perl_op_append_list(pTHX_ I32 optype, OP* first, OP* last);
+PERL_CALLCONV OPclass Perl_op_class(pTHX_ const OP *o);
PERL_CALLCONV void Perl_op_clear(pTHX_ OP* o);
#define PERL_ARGS_ASSERT_OP_CLEAR \
assert(o)
https://perl5.git.perl.org / perl5.git / commitdiff