Skip to content

Commit 2d66a3a

Browse files
committed
sv_setsv_cow: apply the same tests we do for a normal COW copy
Previously if you had a successful match against an SV with a SvLEN() large relative to the SvCUR() the regexp engine would use sv_setsv_cow() to make a COW copy of the matched SV, extending the life of the large allocation buffer. A normal sv_setsv() normally didn't do such a COW copy, but the above also marked the source SV as COW, so further copies of the SV could even further extend the lifetime of the buffer, eg: while (<>) { # readline tends to make large SvLEN() /something/; # some sort of match push @save, $_; # with a successful match, the large $_ buffer # survives until @save is released } Fixes part of #21877
1 parent ba90231 commit 2d66a3a

File tree

2 files changed

+8
-1
lines changed

2 files changed

+8
-1
lines changed

regexec.c

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3572,7 +3572,7 @@ S_reg_set_capture_string(pTHX_ REGEXP * const rx,
35723572
#endif
35733573
{
35743574
#ifdef PERL_ANY_COW
3575-
didnt_cow:
3575+
didnt_cow: ;
35763576
#endif
35773577
SSize_t min = 0;
35783578
SSize_t max = strend - strbeg;

sv.c

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4927,6 +4927,13 @@ Perl_sv_setsv_cow(pTHX_ SV **pdsv, SV *ssv)
49274927
sv_dump(dsv);
49284928
}
49294929
#endif
4930+
if (!SvIsCOW(ssv) &&
4931+
(!CHECK_COWBUF_THRESHOLD(cur, len)
4932+
|| ! CHECK_COW_THRESHOLD(cur, len))) {
4933+
DEBUG_C(PerlIO_printf(Perl_debug_log,
4934+
"Fast copy on write: Sizes not appropriate to COW\n"));
4935+
return FALSE;
4936+
}
49304937
if (dsv) {
49314938
if (SvTHINKFIRST(dsv))
49324939
sv_force_normal_flags(dsv, SV_COW_DROP_PV);

0 commit comments

Comments
 (0)