Stop passing the package and the name from the magical callback to the check function

We can infer those from the gv.

Also, properly delete the placeholder when testing if the symbol exists
by hooking into the gelem check function.

diff --git a/Op.xs b/Op.xs
index ba33ea64b18c43d966768bcfc72a20d28ea43497..b1ecdb483d46f79365aa519e1b40460751311607 100644 (file)
--- 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: $

diff --git a/lib/Sub/Op.pm b/lib/Sub/Op.pm
index a7ad9f9cbd8081eb8fa66833516d5f6bbac6bce5..6459b04c3b64a6977746d416ee9c17cae833da23 100644 (file)
--- a/lib/Sub/Op.pm
+++ b/lib/Sub/Op.pm
@@ -117,8 +117,6 @@ my $sw = Variable::Magic::wizard(
   my $pkg = $data->{pkg};
   my $fqn = join '::', $pkg, $name;
 
-  _incoming($name, $pkg);
-
   no strict 'refs';
   *$fqn = $placeholder unless exists &$fqn;
 

diff --git a/t/10-base.t b/t/10-base.t
index 891a8cbc693669dca37055f1c77b5f1b2449f078..1f785e5b4897e9ef9d746edcbba9f6919893677f 100644 (file)
--- a/t/10-base.t
+++ b/t/10-base.t
@@ -5,7 +5,7 @@ use warnings;
 
 use blib 't/Sub-Op-Test';
 
-use Test::More tests => 2 * 15 + 3 * 1 + 2 * 23;
+use Test::More tests => 2 * 15 + 3 * 2 + 2 * 28;
 
 our $called;
 
@@ -142,3 +142,7 @@ foo 1;
 bar 2;
 ----
 foo, bar # () # [ 1 ], [ 2 ] # foo, bar
+####
+foo 1, foo(2), 3, bar(4, foo(bar, 5), 6);
+----
+foo, bar # @_ # [ 2 ], [ ], [ 5 ], [ 4, 5, 6 ], [ 1, 2, 3, 4, 5, 6 ] # foo, bar, foo, bar, foo