File _service:tar_scm:threads-shared-1.59-Upgrade-to... of Package perl-threads-shared

File _service:tar_scm:threads-shared-1.59-Upgrade-to-1.60.patch of Package perl-threads-shared (Revision fe36588d8538cbc123731f2eb93f4682)

Currently displaying revision fe36588d8538cbc123731f2eb93f4682 , Show latest

From 2ec58402d05eb12d0b9387963941f1e445d9aa5b Mon Sep 17 00:00:00 2001
From: Jitka Plesnikova <jplesnik@redhat.com>
Date: Fri, 26 Apr 2019 15:00:30 +0200
Subject: [PATCH] Upgrade to 1.60
 
---
 lib/threads/shared.pm |  4 ++--
 shared.xs             | 39 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 2 deletions(-)
 
diff --git a/lib/threads/shared.pm b/lib/threads/shared.pm
index f7e5ff8..45ad154 100644
--- a/lib/threads/shared.pm
+++ b/lib/threads/shared.pm
@@ -8,7 +8,7 @@ use Config;
 
 use Scalar::Util qw(reftype refaddr blessed);
 
-our $VERSION = '1.59'; # Please update the pod, too.
+our $VERSION = '1.60'; # Please update the pod, too.
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -196,7 +196,7 @@ threads::shared - Perl extension for sharing data structures between threads
 
 =head1 VERSION
 
-This document describes threads::shared version 1.59
+This document describes threads::shared version 1.60
 
 =head1 SYNOPSIS
 
diff --git a/shared.xs b/shared.xs
index d0f7d1e..6cdf094 100644
--- a/shared.xs
+++ b/shared.xs
@@ -115,6 +115,17 @@
  * without the prefix (e.g., sv, tmp or obj).
  */
 
+/* this is lower overhead than warn() and less likely to interfere
+   with other parts of perl (like with the debugger.)
+*/
+#ifdef SHARED_TRACE_LOCKS
+#  define TRACE_LOCK(x) DEBUG_U(x)
+#  define TRACE_LOCKv(x) DEBUG_Uv(x)
+#else
+#  define TRACE_LOCK(x)
+#  define TRACE_LOCKv(x)
+#endif
+
 #define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
@@ -211,8 +222,24 @@ recursive_lock_release(pTHX_ recursive_lock_t *lock)
         if (--lock->locks == 0) {
             lock->owner = NULL;
             COND_SIGNAL(&lock->cond);
+            TRACE_LOCK(
+                    PerlIO_printf(Perl_debug_log, "shared lock released %p for %p at %s:%d\n",
+                                  lock, aTHX, CopFILE(PL_curcop), CopLINE(PL_curcop))
+                    );
+        }
+        else {
+            TRACE_LOCKv(
+                    PerlIO_printf(Perl_debug_log, "shared lock unbump %p for %p at %s:%d\n",
+                                  lock, aTHX, CopFILE(PL_curcop), CopLINE(PL_curcop))
+                    );
         }
     }
+    else {
+        TRACE_LOCK(
+                PerlIO_printf(Perl_debug_log, "bad shared lock release %p for %p (owned by %p) at %s:%d\n",
+                               lock, aTHX, lock->owner, CopFILE(PL_curcop), CopLINE(PL_curcop))
+                 );
+    }
     MUTEX_UNLOCK(&lock->mutex);
 }
 
@@ -224,8 +251,16 @@ recursive_lock_acquire(pTHX_ recursive_lock_t *lock, const char *file, int line)
     assert(aTHX);
     MUTEX_LOCK(&lock->mutex);
     if (lock->owner == aTHX) {
+        TRACE_LOCKv(
+                 PerlIO_printf(Perl_debug_log, "shared lock bump %p (%p) at %s:%d\n",
+                               lock, lock->owner, CopFILE(PL_curcop), CopLINE(PL_curcop))
+                 );
         lock->locks++;
     } else {
+        TRACE_LOCK(
+                 PerlIO_printf(Perl_debug_log, "shared lock try %p for %p (owned by %p) at %s:%d\n",
+                               lock, aTHX, lock->owner, CopFILE(PL_curcop), CopLINE(PL_curcop))
+                 );
         while (lock->owner) {
 #ifdef DEBUG_LOCKS
             Perl_warn(aTHX_ " %p waiting - owned by %p %s:%d\n",
@@ -233,6 +268,10 @@ recursive_lock_acquire(pTHX_ recursive_lock_t *lock, const char *file, int line)
 #endif
             COND_WAIT(&lock->cond,&lock->mutex);
         }
+        TRACE_LOCK(
+                 PerlIO_printf(Perl_debug_log, "shared lock got %p at %s:%d\n",
+                               lock, CopFILE(PL_curcop), CopLINE(PL_curcop))
+                 );
         lock->locks = 1;
         lock->owner = aTHX;
 #ifdef DEBUG_LOCKS
-- 
2.20.1