The global context isn't needed before we check the hint

[perl/modules/Sub-Op.git] / Op.xs

diff --git a/Op.xs b/Op.xs
index 490dc2d77addcdab4d360e0d3685d4e366762584..ba33ea64b18c43d966768bcfc72a20d28ea43497 100644 (file)
--- a/Op.xs
+++ b/Op.xs
@@ -107,6 +107,12 @@ void sub_op_register(pTHX_ const sub_op_keyword *k) {
   PL_custom_op_descs = newHV();
  (void) hv_store_ent(PL_custom_op_descs, key, newSVpv(k->name, k->len), 0);
 
+ if (k->check) {
+  SV *check = newSViv(PTR2IV(k->check));
+  sv_magicext(key, check, PERL_MAGIC_ext, NULL, k->ud, 0);
+  SvREFCNT_dec(check);
+ }
+
  {
   dMY_CXT;
   (void) hv_store(MY_CXT.map, k->name, k->len, key, 0);
@@ -171,8 +177,6 @@ STATIC IV sub_op_hint(pTHX) {
 STATIC OP *(*sub_op_old_ck_entersub)(pTHX_ OP *) = 0;
 
 STATIC OP *sub_op_ck_entersub(pTHX_ OP *o) {
- dMY_CXT;
-
  o = CALL_FPTR(sub_op_old_ck_entersub)(aTHX_ o);
 
  if (sub_op_hint()) {
@@ -267,6 +271,14 @@ STATIC OP *sub_op_ck_entersub(pTHX_ OP *o) {
       last_arg->op_sibling = NULL;
      op_free(rv2cv);
 
+     {
+      MAGIC *mg = mg_find(pp_sv, PERL_MAGIC_ext);
+      if (mg) {
+       sub_op_check_t check = INT2PTR(sub_op_check_t, SvIVX(mg->mg_obj));
+       o = CALL_FPTR(check)(aTHX_ o, mg->mg_ptr);
+      }
+     }
+
      sub_op_linklist(o);
     }
    }