Add support for the check hook and test multiple keywords

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

diff --git a/Op.xs b/Op.xs
index 490dc2d77addcdab4d360e0d3685d4e366762584..5c9413b18afdeb95f7e69f654532d2649d45ee15 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);
@@ -267,6 +273,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);
     }
    }