Add support for the check hook and test multiple keywords

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

diff --git a/t/Sub-Op-Test/Test.xs b/t/Sub-Op-Test/Test.xs
index 4750507ad9ce45eb3ba3ed46d0c600d50987cafb..b3179698622f1592fcfe6c1ba5562ceca965bdc6 100644 (file)
--- a/t/Sub-Op-Test/Test.xs
+++ b/t/Sub-Op-Test/Test.xs
@@ -11,19 +11,38 @@
 
 #include "sub_op.h"
 
-STATIC SV *sub_op_test_cb = NULL;
+STATIC HV *sub_op_test_map = NULL;
+
+STATIC OP *sub_op_test_check(pTHX_ OP *o, void *ud_) {
+ char buf[sizeof(void*)*2+1];
+ SV *cb = ud_;
+
+ (void) hv_store(sub_op_test_map, buf, sprintf(buf, "%"UVxf, PTR2UV(o)), cb, 0);
+
+ return o;
+}
 
 STATIC OP *sub_op_test_pp(pTHX) {
  dSP;
  dMARK;
+ SV *cb;
  int i, items;
 
+ {
+  char buf[sizeof(void*)*2+1];
+  SV **svp;
+  svp = hv_fetch(sub_op_test_map, buf, sprintf(buf, "%"UVxf, PTR2UV(PL_op)), 0);
+  if (!svp)
+   RETURN;
+  cb = *svp;
+ }
+
  ENTER;
  SAVETMPS;
 
  PUSHMARK(MARK);
 
- items = call_sv(sub_op_test_cb, G_ARRAY);
+ items = call_sv(cb, G_ARRAY);
 
  SPAGAIN;
  for (i = 0; i < items; ++i)
@@ -42,27 +61,25 @@ MODULE = Sub::Op::Test      PACKAGE = Sub::Op::Test
 
 PROTOTYPES: ENABLE
 
+BOOT:
+{
+ sub_op_test_map = newHV();
+}
+
 void
-_init(SV *name)
-PROTOTYPE: $
+_init(SV *name, SV *cb)
+PROTOTYPE: $$
 PREINIT:
  sub_op_keyword k;
-PPCODE:
- k.name  = SvPV_const(name, k.len);
- k.check = 0;
- k.pp    = sub_op_test_pp;
- sub_op_register(aTHX_ &k);
- XSRETURN(0);
-
-void
-_callback(SV *cb)
-PROTOTYPE: $
 PPCODE:
  if (SvROK(cb)) {
   cb = SvRV(cb);
   if (SvTYPE(cb) >= SVt_PVCV) {
-   SvREFCNT_dec(sub_op_test_cb);
-   sub_op_test_cb = SvREFCNT_inc(cb);
+   k.name  = SvPV_const(name, k.len);
+   k.check = sub_op_test_check;
+   k.ud    = SvREFCNT_inc(cb);
+   k.pp    = sub_op_test_pp;
+   sub_op_register(aTHX_ &k);
   }
  }
  XSRETURN(0);