X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Op.git;a=blobdiff_plain;f=Op.xs;h=b1ecdb483d46f79365aa519e1b40460751311607;hp=ba33ea64b18c43d966768bcfc72a20d28ea43497;hb=3b39085a294ef16114b0d119dc8ebdecbe87fb51;hpb=da3f79dfb936676099e3da9c69cf619a7df005e9

diff --git a/Op.xs b/Op.xs
index ba33ea6..b1ecdb4 100644
--- a/Op.xs
+++ b/Op.xs
@@ -180,115 +180,124 @@ STATIC OP *sub_op_ck_entersub(pTHX_ OP *o) {
  o = CALL_FPTR(sub_op_old_ck_entersub)(aTHX_ o);
 
  if (sub_op_hint()) {
-  dMY_CXT;
-  U32 hash = 0;
-  SV *pkg, *name, *pp_sv;
-
-  pkg  = av_pop(MY_CXT.next_pkg);
-  if (!SvOK(pkg))
-   return o;
+  OP *ex_list, *rv2cv, *gvop, *last_arg = NULL;
+  GV *gv;
 
-  name = av_pop(MY_CXT.next_name);
-  if (!SvOK(name)) {
-   SvREFCNT_dec(pkg);
-   return o;
-  }
+  if (o->op_type != OP_ENTERSUB)
+   goto skip;
+  if (o->op_private & OPpENTERSUB_AMPER) /* hopefully \&foo */
+   goto skip;
 
-  {
-   HV *stash = gv_stashsv(pkg, 0);
-
-   if (stash) {
-    HE *he = hv_fetch_ent(stash, name, 0, 0);
-
-    if (he) {
-     CV *cv;
-     SV *gv = HeVAL(he);
-     hash   = HeHASH(he);
-
-     if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder){
-      SvREFCNT_dec(cv);
-      GvCV(gv) = NULL;
-      if (!GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIO(gv) && !GvFORM(gv))
-       (void) hv_delete_ent(stash, name, G_DISCARD, hash);
-     }
-    }
-   }
-  }
+  ex_list = cUNOPo->op_first;
+  /* pushmark when a method call */
+  if (!ex_list || ex_list->op_type != OP_NULL)
+   goto skip;
 
-  {
-   HE *he = hv_fetch_ent(MY_CXT.map, name, 0, hash);
-   if (!he)
-    goto skip;
+  rv2cv = cUNOPx(ex_list)->op_first;
+  if (!rv2cv)
+   goto skip;
 
-   pp_sv = HeVAL(he);
-   if (!SvOK(pp_sv))
-    goto skip;
+  while (1) {
+   OP *next = rv2cv->op_sibling;
+   if (!next)
+    break;
+   last_arg = rv2cv;
+   rv2cv    = next;
   }
 
-  if (o->op_type != OP_ENTERSUB)
+  if (!(rv2cv->op_flags & OPf_KIDS))
    goto skip;
-  if (o->op_private & OPpENTERSUB_AMPER) /* hopefully \&foo */
+
+  gvop = cUNOPx(rv2cv)->op_first;
+  if (!gvop || gvop->op_type != OP_GV)
    goto skip;
 
+  gv = cGVOPx_gv(gvop);
+
   {
-   OP *ex_list  = cUNOPo->op_first;
-   OP *rv2cv, *gvop;
-   OP *last_arg = NULL;
+   HV *stash = GvSTASH(gv);
+   SV *pp_sv, **svp;
+   CV *cv = NULL;
+   const char *name = GvNAME(gv);
+   I32         len  = GvNAMELEN(gv);
+   dMY_CXT;
 
-   /* pushmark when a method call */
-   if (!ex_list || ex_list->op_type != OP_NULL)
+   svp = hv_fetch(MY_CXT.map, name, len, 0);
+   if (!svp)
     goto skip;
 
-   rv2cv = cUNOPx(ex_list)->op_first;
-   if (!rv2cv)
+   pp_sv = *svp;
+   if (!pp_sv || !SvOK(pp_sv))
     goto skip;
 
-   while (1) {
-    OP *next = rv2cv->op_sibling;
-    if (!next)
-     break;
-    last_arg = rv2cv;
-    rv2cv    = next;
+   if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) {
+    SvREFCNT_dec(cv);
+    GvCV(gv) = NULL;
+    if (!GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIO(gv) && !GvFORM(gv)) {
+     (void) hv_delete(stash, name, len, G_DISCARD);
+    }
    }
 
-   if (!(rv2cv->op_flags & OPf_KIDS))
-    goto skip;
+   o->op_type   = OP_CUSTOM;
+   o->op_ppaddr = INT2PTR(Perl_ppaddr_t, SvIVX(pp_sv));
 
-   gvop = cUNOPx(rv2cv)->op_first;
-   if (!gvop || gvop->op_type != OP_GV)
-    goto skip;
+   if (last_arg)
+    last_arg->op_sibling = NULL;
+
+   op_free(rv2cv);
 
    {
-    GV         *gv   = cGVOPx_gv(gvop);
-    STRLEN      len;
-    const char *s    = SvPV_const(name, len);
-
-    if (GvNAMELEN(gv) == len && strnEQ(GvNAME(gv), s, len)) {
-     o->op_type   = OP_CUSTOM;
-     o->op_ppaddr = INT2PTR(Perl_ppaddr_t, SvIVX(pp_sv));
-
-     if (last_arg)
-      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);
+    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);
   }
+ }
 
 skip:
-  SvREFCNT_dec(pkg);
-  SvREFCNT_dec(name);
+ return o;
+}
+
+STATIC OP *(*sub_op_old_ck_gelem)(pTHX_ OP *) = 0;
+
+STATIC OP *sub_op_ck_gelem(pTHX_ OP *o) {
+ o = CALL_FPTR(sub_op_old_ck_entersub)(aTHX_ o);
+
+ if (sub_op_hint()) {
+  OP *rv2gv, *gvop;
+  GV *gv;
+
+  rv2gv = cUNOPo->op_first;
+  if (!rv2gv)
+   goto skip;
+
+  gvop = cUNOPx(rv2gv)->op_first;
+  if (!gvop || gvop->op_type != OP_GV)
+   goto skip;
+
+  gv = cGVOPx_gv(gvop);
+  if (!gv)
+   goto skip;
+
+  {
+   CV *cv;
+   dMY_CXT;
+
+   if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) {
+    SvREFCNT_dec(cv);
+    GvCV(gv) = NULL;
+    if (!GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIO(gv) && !GvFORM(gv)) {
+     (void)hv_delete(GvSTASH(gv), GvNAME_get(gv), GvNAMELEN_get(gv), G_DISCARD);
+    }
+   }
+  }
  }
 
+skip:
  return o;
 }
 
@@ -311,6 +320,8 @@ BOOT:
 
  sub_op_old_ck_entersub = PL_check[OP_ENTERSUB];
  PL_check[OP_ENTERSUB]  = sub_op_ck_entersub;
+ sub_op_old_ck_gelem    = PL_check[OP_GELEM];
+ PL_check[OP_GELEM]     = sub_op_ck_gelem;
 }
 
 #if SO_THREADSAFE
@@ -335,7 +346,7 @@ CODE:
   MY_CXT.next_pkg    = newAV();
   MY_CXT.next_name   = newAV();
   MY_CXT.placeholder = placeholder;
-  MY_CXT.owner = aTHX;
+  MY_CXT.owner       = aTHX;
  }
 
 #endif /* SO_THREADSAFE */
@@ -354,15 +365,6 @@ PPCODE:
  }
  XSRETURN(0);
 
-void
-_incoming(SV *name, SV *pkg)
-PROTOTYPE: $$
-PPCODE:
- dMY_CXT;
- av_push(MY_CXT.next_pkg,  SvREFCNT_inc(pkg));
- av_push(MY_CXT.next_name, SvREFCNT_inc(name));
- XSRETURN(0);
-
 void
 _custom_name(SV *op)
 PROTOTYPE: $