fix a segfault in run-time qr//s with (?{})

While assembling the regex, it was was examining CONSTs in the optree
using the wrong pad. When consts are moved into the pad on threaded
builds, segvs might be the result.

diff --git a/regcomp.c b/regcomp.c
index 8e6cbdd..29434b9 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5315,8 +5315,15 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
        int ncode = 0;
 
        for (o = cLISTOPx(expr)->op_first; o; o = o->op_sibling) {
-           if (o->op_type == OP_CONST && SvUTF8(cSVOPo_sv))
-               code_is_utf8 = 1;
+           if (o->op_type == OP_CONST) {
+                /* skip if we have SVs as well as OPs. In this case,
+                 * a) we decide utf8 based on SVs not OPs;
+                 * b) the current pad may not match that which the ops
+                 *    were compiled in, so, so on threaded builds,
+                 *    cSVOPo_sv would look in the wrong pad */
+                if (!pat_count && SvUTF8(cSVOPo_sv))
+                    code_is_utf8 = 1;
+            }
            else if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL))
                /* count of DO blocks */
                ncode++;

diff --git a/t/re/pat_re_eval.t b/t/re/pat_re_eval.t
index 061e7e5..cef15a0 100644 (file)
--- a/t/re/pat_re_eval.t
+++ b/t/re/pat_re_eval.t
@@ -23,7 +23,7 @@ BEGIN {
 }
 
 
-plan tests => 463;  # Update this when adding/deleting tests.
+plan tests => 464;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1041,6 +1041,23 @@ sub run_tests {
        is($m, 'a', '?pat? with (??{a,b,c})');
     }
 
+    {
+       # this code won't actually fail, but it used to fail valgrind,
+       # so its here just to make sure valgrind doesn't fail again
+       # While examining the ops of the secret anon sub wrapped around
+       # the qr//, the pad of the sub was in scope, so cSVOPo_sv
+       # got the const from the wrong pad. By having lots of $s's
+       # (aka gvsv(*s), this forces the targs of the consts which have
+       # been moved to the pad, to have high indices.
+
+       sub {
+           local our $s = "abc";
+           my $qr = qr/^(?{1})$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s/;
+       }->();
+       pass("cSVOPo_sv");
+    }
+
+
 
 } # End of sub run_tests