95 lines
3.4 KiB
Diff
95 lines
3.4 KiB
Diff
From defb77b559d3c08f94e6db14937a91a4cac8e204 Mon Sep 17 00:00:00 2001
|
|
From: David Mitchell <davem@iabyn.com>
|
|
Date: Fri, 14 Apr 2017 10:51:56 +0100
|
|
Subject: [PATCH] threads::shared: alloc arenas with correct context
|
|
MIME-Version: 1.0
|
|
Content-Type: text/plain; charset=UTF-8
|
|
Content-Transfer-Encoding: 8bit
|
|
|
|
RT #131124
|
|
|
|
In a couple of places in shared.xs, it calls sv_newmortal() with
|
|
a perl context different from that currently set by PERL_SET_CONTEXT().
|
|
If sv_newmortal() happens to trigger the malloc of a new SV HEAD arena,
|
|
then under PERL_TRACK_MEMPOOL, this will cause panics when the arena is
|
|
freed or realloced.
|
|
|
|
Petr Písař: Ported to 1.55 to not increase version to 1.56.
|
|
|
|
---
|
|
dist/threads-shared/shared.xs | 6 ++++--
|
|
dist/threads-shared/t/object2.t | 24 +++++++++++++++++++++++-
|
|
3 files changed, 29 insertions(+), 5 deletions(-)
|
|
|
|
diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs
|
|
index dab5e36..3c1b5e6 100644
|
|
--- a/dist/threads-shared/shared.xs
|
|
+++ b/dist/threads-shared/shared.xs
|
|
@@ -1104,8 +1104,9 @@ sharedsv_array_mg_CLEAR(pTHX_ SV *sv, MAGIC *mg)
|
|
if (!sv) continue;
|
|
if ( (SvOBJECT(sv) || (SvROK(sv) && (sv = SvRV(sv))))
|
|
&& SvREFCNT(sv) == 1 ) {
|
|
- SV *tmp = Perl_sv_newmortal(caller_perl);
|
|
+ SV *tmp;
|
|
PERL_SET_CONTEXT((aTHX = caller_perl));
|
|
+ tmp = sv_newmortal();
|
|
sv_upgrade(tmp, SVt_RV);
|
|
get_RV(tmp, sv);
|
|
PERL_SET_CONTEXT((aTHX = PL_sharedsv_space));
|
|
@@ -1384,8 +1385,9 @@ STORESIZE(SV *obj,IV count)
|
|
if ( (SvOBJECT(sv) || (SvROK(sv) && (sv = SvRV(sv))))
|
|
&& SvREFCNT(sv) == 1 )
|
|
{
|
|
- SV *tmp = Perl_sv_newmortal(caller_perl);
|
|
+ SV *tmp;
|
|
PERL_SET_CONTEXT((aTHX = caller_perl));
|
|
+ tmp = sv_newmortal();
|
|
sv_upgrade(tmp, SVt_RV);
|
|
get_RV(tmp, sv);
|
|
PERL_SET_CONTEXT((aTHX = PL_sharedsv_space));
|
|
diff --git a/dist/threads-shared/t/object2.t b/dist/threads-shared/t/object2.t
|
|
index 3d795b9..31c3797 100644
|
|
--- a/dist/threads-shared/t/object2.t
|
|
+++ b/dist/threads-shared/t/object2.t
|
|
@@ -17,7 +17,7 @@ use ExtUtils::testlib;
|
|
|
|
BEGIN {
|
|
$| = 1;
|
|
- print("1..131\n"); ### Number of tests that will be run ###
|
|
+ print("1..133\n"); ### Number of tests that will be run ###
|
|
};
|
|
|
|
use threads;
|
|
@@ -445,6 +445,28 @@ ok($destroyed[$ID], 'Scalar object removed from shared scalar');
|
|
::ok($count == $n, "remove array object by undef");
|
|
}
|
|
|
|
+# RT #131124
|
|
+# Emptying a shared array creates new temp SVs. If there are no spare
|
|
+# SVs, a new arena is allocated. shared.xs was mallocing a new arena
|
|
+# with the wrong perl context set, meaning that when the arena was later
|
|
+# freed, it would "panic: realloc from wrong pool"
|
|
+#
|
|
+
|
|
+{
|
|
+ threads->new(sub {
|
|
+ my @a :shared;
|
|
+ push @a, bless &threads::shared::share({}) for 1..1000;
|
|
+ undef @a; # this creates lots of temp SVs
|
|
+ })->join;
|
|
+ ok(1, "#131124 undef array doesnt panic");
|
|
+
|
|
+ threads->new(sub {
|
|
+ my @a :shared;
|
|
+ push @a, bless &threads::shared::share({}) for 1..1000;
|
|
+ @a = (); # this creates lots of temp SVs
|
|
+ })->join;
|
|
+ ok(1, "#131124 clear array doesnt panic");
|
|
+}
|
|
|
|
|
|
# EOF
|
|
--
|
|
2.7.4
|
|
|