This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldelta for a951350815 (PerlIO-scalar)
[perl5.git] / ext / B / B.xs
index a4386b6..e2ebdad 100644 (file)
@@ -241,6 +241,38 @@ make_op_object(pTHX_ const OP *o)
     return opsv;
 }
 
+
+static SV *
+get_overlay_object(pTHX_ const OP *o, const char * const name, U32 namelen)
+{
+    HE *he;
+    SV **svp;
+    SV *key;
+    SV *sv =get_sv("B::overlay", 0);
+    if (!sv || !SvROK(sv))
+       return NULL;
+    sv = SvRV(sv);
+    if (SvTYPE(sv) != SVt_PVHV)
+       return NULL;
+    key = newSViv(PTR2IV(o));
+    he = hv_fetch_ent((HV*)sv, key, 0, 0);
+    SvREFCNT_dec(key);
+    if (!he)
+       return NULL;
+    sv = HeVAL(he);
+    if (!sv || !SvROK(sv))
+       return NULL;
+    sv = SvRV(sv);
+    if (SvTYPE(sv) != SVt_PVHV)
+       return NULL;
+    svp = hv_fetch((HV*)sv, name, namelen, 0);
+    if (!svp)
+       return NULL;
+    sv = *svp;
+    return sv;
+}
+
+
 static SV *
 make_sv_object(pTHX_ SV *sv)
 {
@@ -629,8 +661,7 @@ struct OP_methods {
     STR_WITH_LEN("first"),   OPp,    offsetof(struct unop, op_first),     /* 5*/
     STR_WITH_LEN("last"),    OPp,    offsetof(struct binop, op_last),    /* 6*/
     STR_WITH_LEN("other"),   OPp,    offsetof(struct logop, op_other),   /* 7*/
-    STR_WITH_LEN("pmreplstart"), OPp,
-            offsetof(struct pmop,   op_pmstashstartu.op_pmreplstart),   /* 8*/
+    STR_WITH_LEN("pmreplstart"), 0, -1,                                  /* 8*/
     STR_WITH_LEN("redoop"),  OPp,    offsetof(struct loop, op_redoop),   /* 9*/
     STR_WITH_LEN("nextop"),  OPp,    offsetof(struct loop, op_nextop),   /*10*/
     STR_WITH_LEN("lastop"),  OPp,    offsetof(struct loop, op_lastop),   /*11*/
@@ -967,12 +998,25 @@ next(o)
     PPCODE:
        if (ix < 0 || ix > 46)
            croak("Illegal alias %d for B::*OP::next", (int)ix);
-       offset = op_methods[ix].offset;
+       ret = get_overlay_object(aTHX_ o,
+                           op_methods[ix].name, op_methods[ix].namelen);
+       if (ret) {
+           ST(0) = ret;
+           XSRETURN(1);
+       }
 
        /* handle non-direct field access */
 
+       offset = op_methods[ix].offset;
        if (offset < 0) {
            switch (ix) {
+           case 8: /* pmreplstart */
+               ret = make_op_object(aTHX_
+                               cPMOPo->op_type == OP_SUBST
+                                   ?  cPMOPo->op_pmstashstartu.op_pmreplstart
+                                   : NULL
+                     );
+               break;
 #ifdef USE_ITHREADS
            case 21: /* filegv */
                ret = make_sv_object(aTHX_ (SV *)CopFILEGV((COP*)o));
@@ -1904,7 +1948,7 @@ PadlistARRAYelt(padlist, idx)
        B::PADLIST      padlist
        PADOFFSET       idx
     PPCODE:
-       if (idx >= 0 && PadlistMAX(padlist) >= 0
+       if (PadlistMAX(padlist) >= 0
         && idx <= PadlistMAX(padlist))
            XPUSHs(make_sv_object(aTHX_
                                  (SV *)PadlistARRAY(padlist)[idx]));