rpms/perl-threads-shared
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
f23
perl-threads-shared/threads-shared-1.46-Upgrade-to-1.48.patch
Petr Písař 2c9b0c3950 1.48 bump in order to dual-live with perl 5.22
2015-05-05 17:30:57 +02:00

251 lines
7.7 KiB
Diff
Raw Permalink Blame History

From dcf350f9fb1025ac7d5b69b5bf1375a500c381c3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Tue, 5 May 2015 14:39:38 +0200
Subject: [PATCH] Upgrade to 1.48
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
The sources are bundled with perl-5.21.11.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
lib/threads/shared.pm | 4 ++--
shared.xs | 42 +++++++++++++++++++++++++++++++-----------
t/av_simple.t | 12 +++++++++++-
t/hv_refs.t | 2 +-
t/object2.t | 43 ++++++++++++++++++++++++++++++++++++++++++-
5 files changed, 87 insertions(+), 16 deletions(-)
diff --git a/lib/threads/shared.pm b/lib/threads/shared.pm
index bad2c41..cdb1990 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.46'; # Please update the pod, too.
+our $VERSION = '1.48'; # 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.46
+This document describes threads::shared version 1.48
=head1 SYNOPSIS
diff --git a/shared.xs b/shared.xs
index f59a82a..ee52fa1 100644
--- a/shared.xs
+++ b/shared.xs
@@ -136,7 +136,7 @@
/*
* The shared things need an interpreter to live in ...
*/
-PerlInterpreter *PL_sharedsv_space; /* The shared sv space */
+static PerlInterpreter *PL_sharedsv_space; /* The shared sv space */
/* To access shared space we fake aTHX in this scope and thread's context */
/* Bug #24255: We include ENTER+SAVETMPS/FREETMPS+LEAVE with
@@ -177,7 +177,7 @@ typedef struct {
#endif
} recursive_lock_t;
-recursive_lock_t PL_sharedsv_lock; /* Mutex protecting the shared sv space */
+static recursive_lock_t PL_sharedsv_lock; /* Mutex protecting the shared sv space */
void
recursive_lock_init(pTHX_ recursive_lock_t *lock)
@@ -291,7 +291,7 @@ sharedsv_userlock_free(pTHX_ SV *sv, MAGIC *mg)
return (0);
}
-MGVTBL sharedsv_userlock_vtbl = {
+static const MGVTBL sharedsv_userlock_vtbl = {
0, /* get */
0, /* set */
0, /* len */
@@ -332,10 +332,10 @@ MGVTBL sharedsv_userlock_vtbl = {
the shared thing.
*/
-extern MGVTBL sharedsv_scalar_vtbl; /* Scalars have this vtable */
-extern MGVTBL sharedsv_array_vtbl; /* Hashes and arrays have this
+extern const MGVTBL sharedsv_scalar_vtbl; /* Scalars have this vtable */
+extern const MGVTBL sharedsv_array_vtbl; /* Hashes and arrays have this
- like 'tie' */
-extern MGVTBL sharedsv_elem_vtbl; /* Elements of hashes and arrays have
+extern const MGVTBL sharedsv_elem_vtbl; /* Elements of hashes and arrays have
this _AS WELL AS_ the scalar magic:
The sharedsv_elem_vtbl associates the element with the array/hash and
the sharedsv_scalar_vtbl associates it with the value
@@ -878,7 +878,7 @@ sharedsv_scalar_mg_local(pTHX_ SV* nsv, MAGIC *mg)
}
#endif
-MGVTBL sharedsv_scalar_vtbl = {
+const MGVTBL sharedsv_scalar_vtbl = {
sharedsv_scalar_mg_get, /* get */
sharedsv_scalar_mg_set, /* set */
0, /* len */
@@ -1039,7 +1039,7 @@ sharedsv_elem_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
return (0);
}
-MGVTBL sharedsv_elem_vtbl = {
+const MGVTBL sharedsv_elem_vtbl = {
sharedsv_elem_mg_FETCH, /* get */
sharedsv_elem_mg_STORE, /* set */
0, /* len */
@@ -1152,7 +1152,7 @@ sharedsv_array_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
return (0);
}
-MGVTBL sharedsv_array_vtbl = {
+const MGVTBL sharedsv_array_vtbl = {
0, /* get */
0, /* set */
sharedsv_array_mg_FETCHSIZE,/* len */
@@ -1371,9 +1371,29 @@ void
STORESIZE(SV *obj,IV count)
CODE:
dTHXc;
- SV *sobj = SHAREDSV_FROM_OBJ(obj);
+ SV *ssv = SHAREDSV_FROM_OBJ(obj);
+
SHARED_EDIT;
- av_fill((AV*) sobj, count);
+ assert(SvTYPE(ssv) == SVt_PVAV);
+ if (!PL_dirty) {
+ SV **svp = AvARRAY((AV *)ssv);
+ I32 ix = AvFILLp((AV *)ssv);
+ for (;ix >= count; ix--) {
+ SV *sv = svp[ix];
+ if (!sv)
+ continue;
+ if ( (SvOBJECT(sv) || (SvROK(sv) && (sv = SvRV(sv))))
+ && SvREFCNT(sv) == 1 )
+ {
+ SV *tmp = Perl_sv_newmortal(caller_perl);
+ PERL_SET_CONTEXT((aTHX = caller_perl));
+ sv_upgrade(tmp, SVt_RV);
+ get_RV(tmp, sv);
+ PERL_SET_CONTEXT((aTHX = PL_sharedsv_space));
+ }
+ }
+ }
+ av_fill((AV*) ssv, count - 1);
SHARED_RELEASE;
diff --git a/t/av_simple.t b/t/av_simple.t
index 7fab9b2..305c6d5 100644
--- a/t/av_simple.t
+++ b/t/av_simple.t
@@ -27,7 +27,7 @@ sub ok {
BEGIN {
$| = 1;
- print("1..44\n"); ### Number of tests that will be run ###
+ print("1..47\n"); ### Number of tests that will be run ###
};
use threads;
@@ -130,6 +130,16 @@ ok(37, !defined delete($foo[0]), "Check that delete works from a thread");
ok(44, is_shared(@foo), "Check for sharing");
+# RT #122950
+
+@foo = ('a'..'z');
+$#foo = 2;
+
+ok(45, $#foo == 2, "\$#foo assignment: \$#");
+ok(46, @foo == 3, "\$#foo assignment: scalar");
+ok(47, "@foo" eq "a b c", "\$#foo assignment: array interpolation");
+
+
exit(0);
# EOF
diff --git a/t/hv_refs.t b/t/hv_refs.t
index ecefdc6..a2d2206 100644
--- a/t/hv_refs.t
+++ b/t/hv_refs.t
@@ -63,7 +63,7 @@ ok(8, threads::shared::_id($$gg) == threads::shared::_id($$gg2),
sprintf("Check we get the same thing (%x vs %x)",
threads::shared::_id($$gg),threads::shared::_id($$gg2)));
ok(9, $$gg eq $$gg2, "And check the values are the same");
-ok(10, keys %foo == 0, "And make sure we realy have deleted the values");
+ok(10, keys %foo == 0, "And make sure we really have deleted the values");
{
my (%hash1, %hash2);
share(%hash1);
diff --git a/t/object2.t b/t/object2.t
index f59bad8..3d795b9 100644
--- a/t/object2.t
+++ b/t/object2.t
@@ -17,7 +17,7 @@ use ExtUtils::testlib;
BEGIN {
$| = 1;
- print("1..122\n"); ### Number of tests that will be run ###
+ print("1..131\n"); ### Number of tests that will be run ###
};
use threads;
@@ -406,4 +406,45 @@ ok($destroyed[$ID], 'Scalar object removed from undef shared hash');
}
ok($destroyed[$ID], 'Scalar object removed from shared scalar');
+#
+# RT #122950 abandoning array elements (e.g. by setting $#ary)
+# should trigger destructors
+
+{
+ package rt122950;
+
+ my $count = 0;
+ sub DESTROY { $count++ }
+
+ my $n = 4;
+
+ for my $type (0..1) {
+ my @a : shared;
+ $count = 0;
+ push @a, bless &threads::shared::share({}) for 1..$n;
+ for (1..$n) {
+ { # new scope to ensure tmps are freed, destructors called
+ if ($type) {
+ pop @a;
+ }
+ else {
+ $#a = $n - $_ - 1;
+ }
+ }
+ ::ok($count == $_,
+ "remove array object $_ by " . ($type ? "pop" : '$#a=N'));
+ }
+ }
+
+ my @a : shared;
+ $count = 0;
+ push @a, bless &threads::shared::share({}) for 1..$n;
+ {
+ undef @a; # this is implemented internally as $#a = -01
+ }
+ ::ok($count == $n, "remove array object by undef");
+}
+
+
+
# EOF
--
2.1.0
Reference in New Issue View Git Blame Copy Permalink