In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/da1f5b59634bdfea59787843016be4809df50836?hp=cdac396140ede59138b67af076981d0438e36b8b>

- Log -----------------------------------------------------------------
commit da1f5b59634bdfea59787843016be4809df50836
Author: David Mitchell <[email protected]>
Date:   Mon Mar 18 16:41:42 2013 +0000

    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.
-----------------------------------------------------------------------

Summary of changes:
 regcomp.c          |   11 +++++++++--
 t/re/pat_re_eval.t |   19 ++++++++++++++++++-
 2 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/regcomp.c b/regcomp.c
index 8e6cbdd..29434b9 100644
--- 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
--- 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
 

--
Perl5 Master Repository

Reply via email to