X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Op.git;a=blobdiff_plain;f=Op.xs;h=f101fa7509fb1d866cac0d72b6c72a5a598996b3;hp=16b9f465f404264958d632c84c23b028564856a6;hb=302bf09fbd4b673e199bdd22b330ebbdbec4e1fe;hpb=32384f24279ef75bc0b95279c093cf90d8c47195 diff --git a/Op.xs b/Op.xs index 16b9f46..f101fa7 100644 --- a/Op.xs +++ b/Op.xs @@ -120,6 +120,7 @@ void sub_op_init(sub_op_config_t *c) { c->protolen = 0; c->pp = 0; c->check = 0; + c->ref = 0; c->ud = NULL; return; @@ -173,6 +174,7 @@ sub_op_config_t *sub_op_dup(pTHX_ const sub_op_config_t *orig) { dupe->pp = orig->pp; dupe->check = orig->check; + dupe->ref = orig->ref; dupe->ud = orig->ud; return dupe; @@ -209,13 +211,55 @@ STATIC IV so_hint(pTHX) { return (SvOK(hint) && SvIOK(hint)) ? SvIVX(hint) : 0; } +STATIC OP *so_find_gvop(OP *o, OP **last_arg_p, OP **rv2cv_p) { + OP *ex_list, *last_arg, *rv2cv, *gvop; + + ex_list = cUNOPo->op_first; + /* pushmark when a method call */ + if (!ex_list || ex_list->op_type != OP_NULL) + goto skip; + + rv2cv = cUNOPx(ex_list)->op_first; + if (!rv2cv) + goto skip; + + while (1) { + OP *next = rv2cv->op_sibling; + if (!next) + break; + last_arg = rv2cv; + rv2cv = next; + } + + if (!(rv2cv->op_flags & OPf_KIDS)) + goto skip; + + gvop = cUNOPx(rv2cv)->op_first; + + if (gvop && gvop->op_type == OP_GV) + goto done; + +skip: + last_arg = NULL; + rv2cv = NULL; + gvop = NULL; + +done: + if (last_arg_p) + *last_arg_p = last_arg; + if (rv2cv_p) + *rv2cv_p = rv2cv; + + return gvop; +} + STATIC OP *(*so_old_ck_entersub)(pTHX_ OP *) = 0; STATIC OP *so_ck_entersub(pTHX_ OP *o) { o = CALL_FPTR(so_old_ck_entersub)(aTHX_ o); if (so_hint()) { - OP *ex_list, *rv2cv, *gvop, *last_arg = NULL; + OP *ex_list, *last_arg, *rv2cv, *gvop; GV *gv; if (o->op_type != OP_ENTERSUB) @@ -223,28 +267,8 @@ STATIC OP *so_ck_entersub(pTHX_ OP *o) { if (o->op_private & OPpENTERSUB_AMPER) /* hopefully \&foo */ goto skip; - ex_list = cUNOPo->op_first; - /* pushmark when a method call */ - if (!ex_list || ex_list->op_type != OP_NULL) - goto skip; - - rv2cv = cUNOPx(ex_list)->op_first; - if (!rv2cv) - goto skip; - - while (1) { - OP *next = rv2cv->op_sibling; - if (!next) - break; - last_arg = rv2cv; - rv2cv = next; - } - - if (!(rv2cv->op_flags & OPf_KIDS)) - goto skip; - - gvop = cUNOPx(rv2cv)->op_first; - if (!gvop || gvop->op_type != OP_GV) + gvop = so_find_gvop(o, &last_arg, &rv2cv); + if (!gvop) goto skip; gv = cGVOPx_gv(gvop); @@ -299,6 +323,72 @@ skip: return o; } +STATIC OP *(*so_old_ck_refgen)(pTHX_ OP *) = 0; + +STATIC OP *so_ck_refgen(pTHX_ OP *o) { + o = CALL_FPTR(so_old_ck_refgen)(aTHX_ o); + + if (so_hint()) { + OP *kid = o; + OP *prev = NULL; + OP *parent = NULL; + + while (kid->op_flags & OPf_KIDS) { + parent = kid; + kid = cUNOPx(kid)->op_first; + } + + if (!parent) + goto skip; + + for (kid; kid; prev = kid, kid = kid->op_sibling) { + OP *gvop; + GV *gv; + const sub_op_config_t *c; + + if (kid->op_type != OP_RV2CV) + continue; + + gvop = so_find_gvop(kid, NULL, NULL); + if (!gvop) + continue; + + gv = cGVOPx_gv(gvop); + + { + SV **svp; + const char *name = GvNAME(gv); + I32 len = GvNAMELEN(gv); + dMY_CXT; + + svp = hv_fetch(MY_CXT.map, name, len, 0); + if (!svp) + continue; + + c = INT2PTR(const sub_op_config_t *, SvIVX(*svp)); + } + + if (c->ref) { + OP *new_kid = CALL_FPTR(c->ref)(aTHX_ kid, c->ud); + + if (new_kid != kid) { + new_kid->op_sibling = kid->op_sibling; + new_kid->op_next = new_kid; + if (prev) + prev->op_sibling = new_kid; + else + cUNOPx(parent)->op_first = new_kid; + op_null(kid); + kid = new_kid; + } + } + } + } + +skip: + return o; +} + STATIC OP *(*so_old_ck_gelem)(pTHX_ OP *) = 0; STATIC OP *so_ck_gelem(pTHX_ OP *o) { @@ -357,6 +447,8 @@ BOOT: so_old_ck_entersub = PL_check[OP_ENTERSUB]; PL_check[OP_ENTERSUB] = so_ck_entersub; + so_old_ck_refgen = PL_check[OP_REFGEN]; + PL_check[OP_REFGEN] = so_ck_refgen; so_old_ck_gelem = PL_check[OP_GELEM]; PL_check[OP_GELEM] = so_ck_gelem; }