Split the "custom op" part away

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

diff --git a/t/Sub-Op-LexicalSub/LexicalSub.xs b/t/Sub-Op-LexicalSub/LexicalSub.xs
index 285bc42b061997ad20f9c7adaa957aef737f0d18..9e4a2a79143fef770be5af779cd6af791f4f07e1 100644 (file)
--- a/t/Sub-Op-LexicalSub/LexicalSub.xs
+++ b/t/Sub-Op-LexicalSub/LexicalSub.xs
@@ -11,48 +11,50 @@
 
 #include "sub_op.h"
 
-STATIC HV *sols_map = NULL;
-
-STATIC OP *sols_check(pTHX_ OP *o, void *ud_) {
- char buf[sizeof(void*)*2+1];
- SV *cb = ud_;
-
- (void) hv_store(sols_map, buf, sprintf(buf, "%"UVxf, PTR2UV(o)), cb, 0);
+STATIC PADOFFSET sols_find_sv_in_curpad(pTHX_ SV *sv) {
+#define sols_find_sv_in_curpad(S) sols_find_sv_in_curpad(aTHX_ (S))
+ I32 ix;
+ AV  *padlist = CvPADLIST(PL_compcv);
+ AV  *comppad = (AV *) AvARRAY(padlist)[1];
+ SV **curpad  = AvARRAY(comppad);
+
+ for (ix = AvFILLp(comppad); ix > 0; --ix) {
+  if (curpad[ix] == sv)
+   return ix;
+ }
 
- return o;
+ return NOT_IN_PAD;
 }
 
-STATIC OP *sols_pp(pTHX) {
- dSP;
- dMARK;
- SV *cb;
- int i, items;
-
- {
-  char buf[sizeof(void*)*2+1];
-  SV **svp;
-  svp = hv_fetch(sols_map, buf, sprintf(buf, "%"UVxf, PTR2UV(PL_op)), 0);
-  if (!svp)
-   RETURN;
-  cb = *svp;
- }
+STATIC OP *sols_check(pTHX_ OP *o, void *ud_) {
+ OP *gvop, *last_arg, *rv2cv;
+ SV *cv = ud_;
+ GV *gv;
+
+ gvop = sub_op_study(o, &last_arg, &rv2cv);
 
- ENTER;
- SAVETMPS;
+ if (CvANON(cv)) {
+  OP *anon;
 
- PUSHMARK(MARK);
+  CvDEPTH(CvOUTSIDE(cv))++;
+  anon = newSVOP(OP_ANONCODE, 0, (SV *) Perl_cv_clone(aTHX_ (CV *) cv));
+  CvDEPTH(CvOUTSIDE(cv))--;
 
- items = call_sv(cb, G_ARRAY);
+  last_arg->op_sibling = newUNOP(OP_REFGEN, 0, anon);
 
- SPAGAIN;
- for (i = 0; i < items; ++i)
-  SvREFCNT_inc(SP[-i]);
- PUTBACK;
+  op_free(rv2cv);
+ } else {
+  SV *gv = (SV *) CvGV(cv);
 
- FREETMPS;
- LEAVE;
+#ifdef USE_ITHREADS
+  PAD_SVl(cPADOPx(gvop)->op_padix) = gv;
+#else
+  cSVOPx(gvop)->op_sv              = gv;
+#endif
+  SvREFCNT_inc(gv);
+ }
 
- return NORMAL;
+ return o;
 }
 
 /* --- XS ------------------------------------------------------------------ */
@@ -61,11 +63,6 @@ MODULE = Sub::Op::LexicalSub      PACKAGE = Sub::Op::LexicalSub
 
 PROTOTYPES: ENABLE
 
-BOOT:
-{
- sols_map = newHV();
-}
-
 void
 _init(SV *name, SV *cb)
 PROTOTYPE: $$
@@ -75,11 +72,14 @@ PPCODE:
  if (SvROK(cb)) {
   cb = SvRV(cb);
   if (SvTYPE(cb) >= SVt_PVCV) {
-   c.name  = SvPV_const(name, c.namelen);
-   c.check = sols_check;
-   c.ud    = SvREFCNT_inc(cb);
-   c.pp    = sols_pp;
-   sub_op_register(aTHX_ &c);
+   sub_op_init(&c);
+   c.name   = SvPV_const(name, c.namelen);
+   if (SvPOK(cb)) { /* Sub is prototyped */
+    c.proto = SvPV_const(cb, c.protolen);
+   }
+   c.check  = sols_check;
+   c.ud     = SvREFCNT_inc(cb);
+   sub_op_register(aTHX_ &c, 0);
   }
  }
  XSRETURN(0);