]> git.vpit.fr Git - perl/modules/Sub-Op.git/blobdiff - t/Sub-Op-LexicalSub/LexicalSub.xs
Split the "custom op" part away
[perl/modules/Sub-Op.git] / t / Sub-Op-LexicalSub / LexicalSub.xs
index a9b1344bba9b998a7f4033d52f30d7060dfede8f..9e4a2a79143fef770be5af779cd6af791f4f07e1 100644 (file)
 
 #include "sub_op.h"
 
-STATIC HV *sols_map = NULL;
+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 NOT_IN_PAD;
+}
 
 STATIC OP *sols_check(pTHX_ OP *o, void *ud_) {
- char buf[sizeof(void*)*2+1];
- SV *cb = ud_;
+ OP *gvop, *last_arg, *rv2cv;
+ SV *cv = ud_;
+ GV *gv;
 
(void) hv_store(sols_map, buf, sprintf(buf, "%"UVxf, PTR2UV(o)), cb, 0);
gvop = sub_op_study(o, &last_arg, &rv2cv);
 
- return o;
-}
+ if (CvANON(cv)) {
+  OP *anon;
 
-STATIC OP *sols_pp(pTHX) {
- dSP;
- 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;
- }
+  CvDEPTH(CvOUTSIDE(cv))++;
+  anon = newSVOP(OP_ANONCODE, 0, (SV *) Perl_cv_clone(aTHX_ (CV *) cv));
+  CvDEPTH(CvOUTSIDE(cv))--;
 
- XPUSHs(cb);
- PUTBACK;
+  last_arg->op_sibling = newUNOP(OP_REFGEN, 0, anon);
 
- return CALL_FPTR(PL_ppaddr[OP_ENTERSUB])(aTHX);
+  op_free(rv2cv);
+ } else {
+  SV *gv = (SV *) CvGV(cv);
+
+#ifdef USE_ITHREADS
+  PAD_SVl(cPADOPx(gvop)->op_padix) = gv;
+#else
+  cSVOPx(gvop)->op_sv              = gv;
+#endif
+  SvREFCNT_inc(gv);
+ }
+
+ return o;
 }
 
 /* --- XS ------------------------------------------------------------------ */
@@ -48,11 +63,6 @@ MODULE = Sub::Op::LexicalSub      PACKAGE = Sub::Op::LexicalSub
 
 PROTOTYPES: ENABLE
 
-BOOT:
-{
- sols_map = newHV();
-}
-
 void
 _init(SV *name, SV *cb)
 PROTOTYPE: $$
@@ -63,10 +73,12 @@ PPCODE:
   cb = SvRV(cb);
   if (SvTYPE(cb) >= SVt_PVCV) {
    sub_op_init(&c);
-   c.name  = SvPV_const(name, c.namelen);
-   c.check = sols_check;
-   c.ud    = SvREFCNT_inc(cb);
-   c.pp    = sols_pp;
+   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);
   }
  }