Projects
openEuler:Mainline
perl-threads-shared
_service:tar_scm:threads-shared-1.59-Upgrade-to...
Sign Up
Log In
Username
Password
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File _service:tar_scm:threads-shared-1.59-Upgrade-to-1.60.patch of Package perl-threads-shared
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
Locations
Projects
Search
Status Monitor
Help
Open Build Service
OBS Manuals
API Documentation
OBS Portal
Reporting a Bug
Contact
Mailing List
Forums
Chat (IRC)
Twitter
Open Build Service (OBS)
is an
openSUSE project
.
浙ICP备2022010568号-2