perl-threads-shared/threads-shared-1.55-Upgrade...

111 lines
3.5 KiB
Diff

From c7f8a613ce96ab9eb7472dfce9beba86c28a4031 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Thu, 11 May 2017 13:03:59 +0200
Subject: [PATCH] Upgrade to 1.56
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Unbundled from perl-5.25.12.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/threads/shared.pm | 4 ++--
shared.xs | 6 ++++--
t/object2.t | 24 +++++++++++++++++++++++-
3 files changed, 29 insertions(+), 5 deletions(-)
diff --git a/lib/threads/shared.pm b/lib/threads/shared.pm
index 5a203b0..73c4dd9 100644
--- a/lib/threads/shared.pm
+++ b/lib/threads/shared.pm
@@ -7,7 +7,7 @@ use warnings;
use Scalar::Util qw(reftype refaddr blessed);
-our $VERSION = '1.55'; # Please update the pod, too.
+our $VERSION = '1.56'; # Please update the pod, too.
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -195,7 +195,7 @@ threads::shared - Perl extension for sharing data structures between threads
=head1 VERSION
-This document describes threads::shared version 1.55
+This document describes threads::shared version 1.56
=head1 SYNOPSIS
diff --git a/shared.xs b/shared.xs
index dab5e36..3c1b5e6 100644
--- a/shared.xs
+++ b/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/t/object2.t b/t/object2.t
index 3d795b9..31c3797 100644
--- a/t/object2.t
+++ b/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.9.3