From: Vincent Pit <vince@profvince.com>
Date: Fri, 25 Sep 2015 10:54:47 +0000 (+0200)
Subject: Improve support for custom ops
X-Git-Tag: rt107294~1
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FVariable-Magic.git;a=commitdiff_plain;h=670e590caf3db942b5e7feddc1e86669f9f46294

Improve support for custom ops

This was added to the core in commit 1830b3d9, which was publicized in perl
5.13.7. Note that our version is slightly different but simpler, since I
can't see how the op type might change during the call to OP_CLASS().
---

diff --git a/Magic.xs b/Magic.xs
index d579f9e..69ad981 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -133,6 +133,14 @@
 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
 #endif
 
+#ifndef OP_NAME
+# define OP_NAME(O) (PL_op_name[(O)->op_type])
+#endif
+
+#ifndef OP_CLASS
+# define OP_CLASS(O) (PL_opargs[(O)->op_type] & OA_CLASS_MASK)
+#endif
+
 #ifdef DEBUGGING
 # define VMG_ASSERT(C) assert(C)
 #else
@@ -420,7 +428,8 @@ static const char *const vmg_opclassnames[] = {
  NULL
 };
 
-static opclass vmg_opclass(const OP *o) {
+static opclass vmg_opclass(pTHX_ const OP *o) {
+#define vmg_opclass(O) vmg_opclass(aTHX_ (O))
 #if 0
  if (!o)
   return OPc_NULL;
@@ -455,7 +464,7 @@ static opclass vmg_opclass(const OP *o) {
   return OPc_PADOP;
 #endif
 
- switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
+ switch (OP_CLASS(o)) {
   case OA_BASEOP:
    return OPc_BASEOP;
   case OA_UNOP:
@@ -473,7 +482,11 @@ static opclass vmg_opclass(const OP *o) {
   case OA_PADOP:
    return OPc_PADOP;
   case OA_PVOP_OR_SVOP:
-   return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
+   return (
+#if VMG_HAS_PERL(5, 13, 7)
+           (o->op_type != OP_CUSTOM) &&
+#endif
+           (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF)))
 #if defined(USE_ITHREADS) && VMG_HAS_PERL(5, 8, 9)
            ? OPc_PADOP : OPc_PVOP;
 #else
@@ -1143,8 +1156,12 @@ static SV *vmg_op_info(pTHX_ unsigned int opinfo) {
 
  switch (opinfo) {
   case VMG_OP_INFO_NAME: {
-   OPCODE t = PL_op->op_type;
-   return sv_2mortal(newSVpvn(PL_op_name[t], vmg_op_name_len[t]));
+   const char *name;
+   STRLEN      name_len;
+   OPCODE      t = PL_op->op_type;
+   name     = OP_NAME(PL_op);
+   name_len = (t == OP_CUSTOM) ? strlen(name) : vmg_op_name_len[t];
+   return sv_2mortal(newSVpvn(name, name_len));
   }
   case VMG_OP_INFO_OBJECT: {
    dMY_CXT;