You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
109 lines
3.2 KiB
109 lines
3.2 KiB
From f5488561bdaab57380bf07e8e66778503a41aca3 Mon Sep 17 00:00:00 2001 |
|
From: Father Chrysostomos <sprout@cpan.org> |
|
Date: Sun, 23 Sep 2012 12:42:15 -0700 |
|
Subject: [PATCH] =?UTF-8?q?Don=E2=80=99t=20leak=20if=20hh=20copying=20dies?= |
|
MIME-Version: 1.0 |
|
Content-Type: text/plain; charset=UTF-8 |
|
Content-Transfer-Encoding: 8bit |
|
|
|
When %^H is copied on entering a new scope, if it happens to have been |
|
tied it can die. This was resulting in leaks, because no protections |
|
were added to handle that case. |
|
|
|
The two things that were leaking were the new hash in hv_copy_hints_hv |
|
and the new value (for an element) in newSVsv. |
|
|
|
By fixing newSVsv itself, this also fixes any potential leaks when |
|
other pieces of code call newSVsv on explosive values. |
|
|
|
Petr Pisar: Ported to 5.16.3 |
|
--- |
|
hv.c | 6 ++++++ |
|
sv.c | 7 ++++--- |
|
t/op/svleak.t | 22 +++++++++++++++++++++- |
|
3 files changed, 31 insertions(+), 4 deletions(-) |
|
|
|
diff --git a/hv.c b/hv.c |
|
index 3c35341..29d6352 100644 |
|
--- a/hv.c |
|
+++ b/hv.c |
|
@@ -1440,6 +1440,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) |
|
const I32 riter = HvRITER_get(ohv); |
|
HE * const eiter = HvEITER_get(ohv); |
|
|
|
+ ENTER; |
|
+ SAVEFREESV(hv); |
|
+ |
|
while (hv_max && hv_max + 1 >= hv_fill * 2) |
|
hv_max = hv_max / 2; |
|
HvMAX(hv) = hv_max; |
|
@@ -1461,6 +1464,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) |
|
} |
|
HvRITER_set(ohv, riter); |
|
HvEITER_set(ohv, eiter); |
|
+ |
|
+ SvREFCNT_inc_simple_void_NN(hv); |
|
+ LEAVE; |
|
} |
|
hv_magic(hv, NULL, PERL_MAGIC_hints); |
|
return hv; |
|
diff --git a/sv.c b/sv.c |
|
index a43feac..597d71b 100644 |
|
--- a/sv.c |
|
+++ b/sv.c |
|
@@ -8764,11 +8764,12 @@ Perl_newSVsv(pTHX_ register SV *const old) |
|
Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string"); |
|
return NULL; |
|
} |
|
+ /* Do this here, otherwise we leak the new SV if this croaks. */ |
|
+ SvGETMAGIC(old); |
|
new_SV(sv); |
|
- /* SV_GMAGIC is the default for sv_setv() |
|
- SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games |
|
+ /* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games |
|
with SvTEMP_off and SvTEMP_on round a call to sv_setsv. */ |
|
- sv_setsv_flags(sv, old, SV_GMAGIC | SV_NOSTEAL); |
|
+ sv_setsv_flags(sv, old, SV_NOSTEAL); |
|
return sv; |
|
} |
|
|
|
diff --git a/t/op/svleak.t b/t/op/svleak.t |
|
index 2f09af3..011c184 100644 |
|
--- a/t/op/svleak.t |
|
+++ b/t/op/svleak.t |
|
@@ -13,7 +13,7 @@ BEGIN { |
|
or skip_all("XS::APItest not available"); |
|
} |
|
|
|
-plan tests => 23; |
|
+plan tests => 24; |
|
|
|
# run some code N times. If the number of SVs at the end of loop N is |
|
# greater than (N-1)*delta at the end of loop 1, we've got a leak |
|
@@ -176,3 +176,23 @@ leak(2, 0, sub { |
|
each %$h; |
|
undef $h; |
|
}, 'tied hash iteration does not leak'); |
|
+ |
|
+# [perl #107000] |
|
+package hhtie { |
|
+ sub TIEHASH { bless [] } |
|
+ sub STORE { $_[0][0]{$_[1]} = $_[2] } |
|
+ sub FETCH { die if $explosive; $_[0][0]{$_[1]} } |
|
+ sub FIRSTKEY { keys %{$_[0][0]}; each %{$_[0][0]} } |
|
+ sub NEXTKEY { each %{$_[0][0]} } |
|
+} |
|
+leak(2,!!$Config{mad}, sub { |
|
+ eval q` |
|
+ BEGIN { |
|
+ $hhtie::explosive = 0; |
|
+ tie %^H, hhtie; |
|
+ $^H{foo} = bar; |
|
+ $hhtie::explosive = 1; |
|
+ } |
|
+ { 1; } |
|
+ `; |
|
+}, 'hint-hash copying does not leak'); |
|
-- |
|
1.8.1.4 |
|
|
|
|