regex and overload: unifiy 1 and N arg branches

When compiling a regex, something like /a$b/ that parses two two args,
was treated in a different code path than /$a/ say, which is only one arg.

In particular the 1-arg code path, where it handled "" overloading, didn't
check for a loop (where the ""-sub returns the overloaded object itself) -
the N-arg branch did handle that. By unififying the branches, we get that
fix for free, and ensure that any future fixes don't have to be applied to
two separate branches.

Re-indented has been left to the commit that follows this.

diff --git a/regcomp.c b/regcomp.c
index 868a2ae..d0a9c4a 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5212,7 +5212,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
     I32 flags;
     I32 minlen = 0;
     U32 rx_flags;
-    SV *pat;
+    SV *pat = NULL;
     SV *code_blocksv = NULL;
 
     /* these are all flags - maybe they should be turned
@@ -5337,6 +5337,10 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
        /* handle a list of SVs */
 
        SV **svp;
+        OP *o = NULL;
+        int n = 0;
+        bool utf8 = 0;
+        STRLEN orig_patlen = 0;
 
        /* apply magic and RE overloading to each arg */
        for (svp = patternp; svp < patternp + pat_count; svp++) {
@@ -5354,14 +5358,10 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
            }
        }
 
-       if (pat_count > 1) {
-           /* concat multiple args and find any code block indexes */
-
-           OP *o = NULL;
-           int n = 0;
-           bool utf8 = 0;
-            STRLEN orig_patlen = 0;
+            /* process args, concat them if there are multiple ones,
+             * and find any code block indexes */
 
+            if (pat_count > 1) {
            if (pRExC_state->num_code_blocks) {
                o = cLISTOPx(expr)->op_first;
                assert(   o->op_type == OP_PUSHMARK
@@ -5385,10 +5385,11 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
            }
            if (utf8)
                SvUTF8_on(pat);
+            }
 
            for (svp = patternp; svp < patternp + pat_count; svp++) {
                SV *sv, *msv = *svp;
-               SV *rx;
+               SV *rx  = NULL;
                bool code = 0;
                 /* we make the assumption here that each op in the list of
                  * op_siblings maps to one SV pushed onto the stack,
@@ -5415,7 +5416,8 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
                    o = o->op_sibling;;
                }
 
-               if ((SvAMAGIC(pat) || SvAMAGIC(msv)) &&
+                /* try concatenation overload ... */
+               if (pat && (SvAMAGIC(pat) || SvAMAGIC(msv)) &&
                        (sv = amagic_call(pat, msv, concat_amg, AMGf_assign)))
                {
                    sv_setsv(pat, sv);
@@ -5423,10 +5425,9 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
                     * code. Pretend we haven't seen it */
                    pRExC_state->num_code_blocks -= n;
                    n = 0;
-                    rx = NULL;
-
                }
                else  {
+                    /* ... or failing that, try "" overload */
                     while (SvAMAGIC(msv)
                             && (sv = AMG_CALLunary(msv, string_amg))
                             && sv != msv
@@ -5439,9 +5440,13 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
                     }
                     if (SvROK(msv) && SvTYPE(SvRV(msv)) == SVt_REGEXP)
                         msv = SvRV(msv);
+                    if (pat) {
                     orig_patlen = SvCUR(pat);
                     sv_catsv_nomg(pat, msv);
                     rx = msv;
+                    }
+                    else
+                        pat = msv;
                     if (code)
                         pRExC_state->code_blocks[n-1].end = SvCUR(pat)-1;
                 }
@@ -5482,21 +5487,10 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
                    }
                }
            }
-           SvSETMAGIC(pat);
-       }
-       else {
-            SV *sv;
-           pat = *patternp;
-            while (SvAMAGIC(pat)
-                    && (sv = AMG_CALLunary(pat, string_amg))
-                    && sv != pat)
-            {
-                pat = sv;
-                SvGETMAGIC(pat);
-            }
-        }
+            if (pat_count > 1)
+                SvSETMAGIC(pat);
 
-       /* handle bare regex: foo =~ $re */
+       /* handle bare (possibly after overloading) regex: foo =~ $re */
        {
            SV *re = pat;
            if (SvROK(re))

diff --git a/t/re/overload.t b/t/re/overload.t
index 4e99bd3..7f562c0 100644 (file)
--- a/t/re/overload.t
+++ b/t/re/overload.t
@@ -33,4 +33,24 @@ no  warnings 'syntax';
     is $1, $TAG, "void context //g against overloaded object";
 }
 
+{
+    # an overloaded stringify returning itself shouldn't loop indefinitely
+
+
+    {
+       package Self;
+       use overload q{""} => sub {
+                   return shift;
+               },
+           fallback => 1;
+    }
+
+    my $obj = bless [], 'Self';
+    my $r = qr/$obj/;
+    pass("self object, 1 arg");
+    $r = qr/foo$obj/;
+    pass("self object, 2 args");
+}
+
+
 done_testing();