Skip to content

Commit 89553a3

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 f71cf50 commit 89553a3

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
@@ -3547,7 +3547,7 @@ S_reg_set_capture_string(pTHX_ REGEXP * const rx,
35473547
#endif
35483548
{
35493549
#ifdef PERL_ANY_COW
3550-
didnt_cow:
3550+
didnt_cow: ;
35513551
#endif
35523552
SSize_t min = 0;
35533553
SSize_t max = strend - strbeg;

sv.c

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4912,6 +4912,13 @@ Perl_sv_setsv_cow(pTHX_ SV **pdsv, SV *ssv)
49124912
sv_dump(dsv);
49134913
}
49144914
#endif
4915+
if (!SvIsCOW(ssv) &&
4916+
(!CHECK_COWBUF_THRESHOLD(cur, len)
4917+
|| ! CHECK_COW_THRESHOLD(cur, len))) {
4918+
DEBUG_C(PerlIO_printf(Perl_debug_log,
4919+
"Fast copy on write: Sizes not appropriate to COW\n"));
4920+
return FALSE;
4921+
}
49154922
if (dsv) {
49164923
if (SvTHINKFIRST(dsv))
49174924
sv_force_normal_flags(dsv, SV_COW_DROP_PV);

0 commit comments

Comments
 (0)