This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pp_regcomp: split overloading and concat tasks
authorDavid Mitchell <davem@iabyn.com>
Wed, 26 Oct 2011 12:21:10 +0000 (13:21 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 13 Jun 2012 12:25:50 +0000 (13:25 +0100)
Make two passes through the list of args: first to apply
magic/overloading, and secondly to concatenate them. This will
shortly allow us to pass a processed, but unconcatenated list to
re_op_compile().

Also, simplify the code by treating the 1-arg case as an arg list
of length 1.  This also allows us to use the tryAMAGICregexp macro
in only one place, and thus to unroll and eliminate it.

pp_ctl.c

index 213f063..3353062 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -81,49 +81,56 @@ PP(pp_regcomp)
     dVAR;
     dSP;
     register PMOP *pm = (PMOP*)cLOGOP->op_other;
+    SV **args, **svp;
+    int nargs;
     SV *tmpstr;
     REGEXP *re = NULL;
 
+    if (PL_op->op_flags & OPf_STACKED) {
+       dMARK;
+       nargs = SP - MARK;
+       args  = ++MARK;
+    }
+    else {
+       nargs = 1;
+       args  = SP;
+    }
+
     /* prevent recompiling under /o and ithreads. */
 #if defined(USE_ITHREADS)
     if (pm->op_pmflags & PMf_KEEP && PM_GETRE(pm)) {
-       if (PL_op->op_flags & OPf_STACKED) {
-           dMARK;
-           SP = MARK;
-       }
-       else
-           (void)POPs;
+       SP = args-1;
        RETURN;
     }
 #endif
 
-#define tryAMAGICregexp(rx)                    \
-    STMT_START {                               \
-       SvGETMAGIC(rx);                         \
-       if (SvROK(rx) && SvAMAGIC(rx)) {        \
-           SV *sv = AMG_CALLunary(rx, regexp_amg); \
-           if (sv) {                           \
-               if (SvROK(sv))                  \
-                   sv = SvRV(sv);              \
-               if (SvTYPE(sv) != SVt_REGEXP)   \
-                   Perl_croak(aTHX_ "Overloaded qr did not return a REGEXP"); \
-               rx = sv;                        \
-           }                                   \
-       }                                       \
-    } STMT_END
-           
+    /* apply magic and RE overloading to each arg */
+
+    for (svp = args; svp <= SP; svp++) {
+       SV *rx = *svp;
+       SvGETMAGIC(rx);
+       if (SvROK(rx) && SvAMAGIC(rx)) {
+           SV *sv = AMG_CALLunary(rx, regexp_amg);
+           if (sv) {
+               if (SvROK(sv))
+                   sv = SvRV(sv);
+               if (SvTYPE(sv) != SVt_REGEXP)
+                   Perl_croak(aTHX_ "Overloaded qr did not return a REGEXP");
+               *svp = sv;
+           }
+       }
+    }
 
-    if (PL_op->op_flags & OPf_STACKED) {
-       /* multiple args; concatenate them */
-       dMARK; dORIGMARK;
+    /* concat multiple args */
+
+    if (nargs > 1) {
        tmpstr = PAD_SV(ARGTARG);
        sv_setpvs(tmpstr, "");
-       while (++MARK <= SP) {
-           SV *msv = *MARK;
+       svp = args-1;
+       while (++svp <= SP) {
+           SV *msv = *svp;
            SV *sv;
 
-           tryAMAGICregexp(msv);
-
            if ((SvAMAGIC(tmpstr) || SvAMAGIC(msv)) &&
                (sv = amagic_call(tmpstr, msv, concat_amg, AMGf_assign)))
            {
@@ -133,14 +140,10 @@ PP(pp_regcomp)
            sv_catsv_nomg(tmpstr, msv);
        }
        SvSETMAGIC(tmpstr);
-       SP = ORIGMARK;
-    }
-    else {
-       tmpstr = POPs;
-       tryAMAGICregexp(tmpstr);
     }
+    else
+       tmpstr = *args;
 
-#undef tryAMAGICregexp
 
     if (SvROK(tmpstr)) {
        SV * const sv = SvRV(tmpstr);
@@ -161,7 +164,7 @@ PP(pp_regcomp)
         SV *lhs;
         const bool was_tainted = PL_tainted;
         if (pm->op_flags & OPf_STACKED)
-           lhs = TOPs;
+           lhs = args[-1];
         else if (pm->op_private & OPpTARGET_MY)
            lhs = PAD_SV(pm->op_targ);
         else lhs = DEFSV;
@@ -247,6 +250,7 @@ PP(pp_regcomp)
        cLOGOP->op_first->op_next = PL_op->op_next;
     }
 #endif
+    SP = args-1;
     RETURN;
 }