summaryrefslogtreecommitdiff
path: root/regcomp.c
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2009-12-02 16:01:10 +0000
committerNicholas Clark <nick@ccl4.org>2009-12-02 16:06:09 +0000
commitc2123ae380a372d506d1b6938667bd785fd8728b (patch)
tree68d6297e99a7e461c2c1e90a5f28c268f5f0988f /regcomp.c
parent99f78760b2efe944c387d081557a95783f362f6a (diff)
downloadperl-c2123ae380a372d506d1b6938667bd785fd8728b.tar.gz
Ensure that pp_qr returns a new regexp SV each time. Resolves RT #69852.
Instead of returning a(nother) reference to the (pre-compiled) regexp in the optree, use reg_temp_copy() to create a copy of it, and return a reference to that. This resolves issues about Regexp::DESTROY not being called in a timely fashion (the original bug tracked by RT #69852), as well as bugs related to blessing regexps, and of assigning to regexps, as described in correspondence added to the ticket. It transpires that we also need to undo the SvPVX() sharing when ithreads cloning a Regexp SV, because mother_re is set to NULL, instead of a cloned copy of the mother_re. This change might fix bugs with regexps and threads in certain other situations, but as yet neither tests nor bug reports have indicated any problems, so it might not actually be an edge case that it's possible to reach.
Diffstat (limited to 'regcomp.c')
-rw-r--r--regcomp.c15
1 files changed, 14 insertions, 1 deletions
diff --git a/regcomp.c b/regcomp.c
index dd03745297..337f0c435a 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -9699,7 +9699,20 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param)
ret->saved_copy = NULL;
#endif
- ret->mother_re = NULL;
+ if (ret->mother_re) {
+ if (SvPVX_const(dstr) == SvPVX_const(ret->mother_re)) {
+ /* Our storage points directly to our mother regexp, but that's
+ 1: a buffer in a different thread
+ 2: something we no longer hold a reference on
+ so we need to copy it locally. */
+ /* Note we need to sue SvCUR() on our mother_re, because it, in
+ turn, may well be pointing to its own mother_re. */
+ SvPV_set(dstr, SAVEPVN(SvPVX_const(ret->mother_re),
+ SvCUR(ret->mother_re)+1));
+ SvLEN_set(dstr, SvCUR(ret->mother_re)+1);
+ }
+ ret->mother_re = NULL;
+ }
ret->gofs = 0;
}
#endif /* PERL_IN_XSUB_RE */