Merge pull request #5 from Dual-Life/develop

1.57 Clang macros

Author: Jerry D. Hedden

Changes

@@ -3,6 +3,12 @@ Revision history for Perl extension threads::shared.
 -
 	-
 
+1.57 Sun May  7 22:48:33 2017
+	- Fix Clang macro backward compatibility per patch by Andy Grundman
+
+1.56 Fri Apr 14 10:51:56 2017 +0100
+	- RT #131124 Memory allocation fix (not released to CPAN)
+
 1.55 Sun Feb 26 18:23:45 2017
 	- Document issue with destructor not called on embedded shared objects
 

README

@@ -1,4 +1,4 @@
-threads::shared version 1.55
+threads::shared version 1.57
 ============================
 
 This module needs Perl 5.8.0 or later compiled with USEITHREADS.

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.57'; # 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.57
 
 =head1 SYNOPSIS
 

shared.xs

@@ -656,14 +656,15 @@ Perl_sharedsv_cond_timedwait(perl_cond *cond, perl_mutex *mut, double abs)
     abs -= (NV)ts.tv_sec;
     ts.tv_nsec = (long)(abs * 1000000000.0);
 
-#if defined(__clang__) || defined(__clang)
+#if defined(CLANG_DIAG_IGNORE)
     CLANG_DIAG_IGNORE(-Wthread-safety);
     /* warning: calling function 'pthread_cond_timedwait' requires holding mutex 'mut' exclusively [-Wthread-safety-analysis] */
 #endif
 
     switch (pthread_cond_timedwait(cond, mut, &ts)) {
 
-#if defined(__clang__) || defined(__clang)
+/* perl.h defines CLANG_DIAG_* but only in 5.24+ */
+#if defined(CLANG_DIAG_RESTORE)
 CLANG_DIAG_RESTORE;
 #endif
 
@@ -1104,8 +1105,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 +1386,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));

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