In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/28399f576f6389d20835cad7ee86f458880fdcda?hp=34bd199a87daedeaeadd8e9ef48032c8307eaa94>
- Log -----------------------------------------------------------------
commit 28399f576f6389d20835cad7ee86f458880fdcda
Author: Jerry D. Hedden <jdhed...@cpan.org>
Date: Tue Oct 2 18:58:32 2012 -0400
Upgrade to threads::shared 1.42
M dist/threads-shared/shared.xs
M dist/threads-shared/t/dualvar.t
commit 9095cc4a20b2690cb271de143285b4f1d66237de
Author: Father Chrysostomos <spr...@cpan.org>
Date: Tue Oct 2 16:11:17 2012 -0700
Revert "Upgrade to threads::shared 1.42"
This reverts commit 34bd199a87daedeaeadd8e9ef48032c8307eaa94.
M dist/threads-shared/shared.xs
M dist/threads-shared/t/dualvar.t
-----------------------------------------------------------------------
Summary of changes:
dist/threads-shared/shared.xs | 80 +++++++++++++++++---------------------
dist/threads-shared/t/dualvar.t | 24 ++++++++++-
2 files changed, 57 insertions(+), 47 deletions(-)
diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs
index 909643c..3dccc39 100644
--- a/dist/threads-shared/shared.xs
+++ b/dist/threads-shared/shared.xs
@@ -304,6 +304,24 @@ MGVTBL sharedsv_userlock_vtbl = {
#endif
};
+
+/* Support for dual-valued variables */
+#ifdef SVf_IVisUV
+# define DUALVAR_FLAGS(sv) \
+ ((SvPOK(sv)) \
+ ? ((SvNOK(sv) || SvNOKp(sv)) ? SVf_NOK \
+ : ((SvIsUV(sv)) ? (SVf_IOK | SVf_IVisUV) \
+ : ((SvIOK(sv) || SvIOKp(sv)) ? SVf_IOK : 0))) \
+ : 0)
+#else
+# define DUALVAR_FLAGS(sv) \
+ ((SvPOK(sv)) \
+ ? ((SvNOK(sv) || SvNOKp(sv)) ? SVf_NOK \
+ : ((SvIOK(sv) || SvIOKp(sv)) ? SVf_IOK : 0)) \
+ : 0)
+#endif
+
+
/*
* Access to shared things is heavily based on MAGIC
* - in mg.h/mg.c/sv.c sense
@@ -326,32 +344,7 @@ extern MGVTBL sharedsv_elem_vtbl; /* Elements of
hashes and arrays have
/* Get shared aggregate SV pointed to by threads::shared::tie magic object */
-STATIC SV *
-S_sharedsv_from_obj(pTHX_ SV *sv)
-{
- return ((SvROK(sv)) ? INT2PTR(SV *, SvIV(SvRV(sv))) : NULL);
-}
-
-
-/* Return SV flags associated with dual-valued variables */
-U32
-S_get_dualvar_flags(pTHX_ SV *sv)
-{
- if (SvPOK(sv) && (SvNIOK(sv) || SvNIOKp(sv))) {
- if (SvNOK(sv) || SvNOKp(sv)) {
- return SVf_NOK;
- }
-#ifdef SVf_IVisUV
- if (SvIsUV(sv)) {
- return (SVf_IOK | SVf_IVisUV);
- }
-#endif
- if (SvIOK(sv) || SvIOKp(sv)) {
- return SVf_IOK;
- }
- }
- return 0;
-}
+#define SHAREDSV_FROM_OBJ(sv) ((SvROK(sv)) ? INT2PTR(SV *, SvIV(SvRV(sv))) :
NULL)
/* Return the user_lock structure (if any) associated with a shared SV.
@@ -426,7 +419,7 @@ Perl_sharedsv_find(pTHX_ SV *sv)
}
/* Just for tidyness of API also handle tie objects */
if (SvROK(sv) && sv_derived_from(sv, "threads::shared::tie")) {
- return (S_sharedsv_from_obj(aTHX_ sv));
+ return (SHAREDSV_FROM_OBJ(sv));
}
return (NULL);
}
@@ -906,7 +899,7 @@ int
sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg)
{
dTHXc;
- SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj);
+ SV *saggregate = SHAREDSV_FROM_OBJ(mg->mg_obj);
SV** svp = NULL;
ENTER_LOCK;
@@ -956,9 +949,9 @@ int
sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg)
{
dTHXc;
- SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj);
+ SV *saggregate = SHAREDSV_FROM_OBJ(mg->mg_obj);
SV **svp;
- U32 dualvar_flags;
+ U32 dualvar_flags = DUALVAR_FLAGS(sv);
/* Theory - SV itself is magically shared - and we have ordered the
magic such that by the time we get here it has been stored
@@ -986,7 +979,6 @@ sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg)
svp = hv_fetch((HV*) saggregate, key, len, 1);
}
CALLER_CONTEXT;
- dualvar_flags = S_get_dualvar_flags(aTHX_ sv);
Perl_sharedsv_associate(aTHX_ sv, *svp);
sharedsv_scalar_store(aTHX_ sv, *svp);
SvFLAGS(*svp) |= dualvar_flags;
@@ -1001,7 +993,7 @@ sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg)
{
dTHXc;
MAGIC *shmg;
- SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj);
+ SV *saggregate = SHAREDSV_FROM_OBJ(mg->mg_obj);
/* Object may not exist during global destruction */
if (! saggregate) {
@@ -1042,7 +1034,7 @@ int
sharedsv_elem_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
{
PERL_UNUSED_ARG(param);
- SvREFCNT_inc_void(S_sharedsv_from_obj(aTHX_ mg->mg_obj));
+ SvREFCNT_inc_void(SHAREDSV_FROM_OBJ(mg->mg_obj));
assert(mg->mg_flags & MGf_DUP);
return (0);
}
@@ -1286,12 +1278,12 @@ void
PUSH(SV *obj, ...)
CODE:
dTHXc;
- SV *sobj = S_sharedsv_from_obj(aTHX_ obj);
+ SV *sobj = SHAREDSV_FROM_OBJ(obj);
int ii;
for (ii = 1; ii < items; ii++) {
SV* tmp = newSVsv(ST(ii));
SV *stmp;
- U32 dualvar_flags = S_get_dualvar_flags(aTHX_ tmp);
+ U32 dualvar_flags = DUALVAR_FLAGS(tmp);
ENTER_LOCK;
stmp = S_sharedsv_new_shared(aTHX_ tmp);
sharedsv_scalar_store(aTHX_ tmp, stmp);
@@ -1308,7 +1300,7 @@ void
UNSHIFT(SV *obj, ...)
CODE:
dTHXc;
- SV *sobj = S_sharedsv_from_obj(aTHX_ obj);
+ SV *sobj = SHAREDSV_FROM_OBJ(obj);
int ii;
ENTER_LOCK;
SHARED_CONTEXT;
@@ -1316,7 +1308,7 @@ UNSHIFT(SV *obj, ...)
CALLER_CONTEXT;
for (ii = 1; ii < items; ii++) {
SV *tmp = newSVsv(ST(ii));
- U32 dualvar_flags = S_get_dualvar_flags(aTHX_ tmp);
+ U32 dualvar_flags = DUALVAR_FLAGS(tmp);
SV *stmp = S_sharedsv_new_shared(aTHX_ tmp);
sharedsv_scalar_store(aTHX_ tmp, stmp);
SHARED_CONTEXT;
@@ -1333,7 +1325,7 @@ void
POP(SV *obj)
CODE:
dTHXc;
- SV *sobj = S_sharedsv_from_obj(aTHX_ obj);
+ SV *sobj = SHAREDSV_FROM_OBJ(obj);
SV* ssv;
ENTER_LOCK;
SHARED_CONTEXT;
@@ -1350,7 +1342,7 @@ void
SHIFT(SV *obj)
CODE:
dTHXc;
- SV *sobj = S_sharedsv_from_obj(aTHX_ obj);
+ SV *sobj = SHAREDSV_FROM_OBJ(obj);
SV* ssv;
ENTER_LOCK;
SHARED_CONTEXT;
@@ -1367,7 +1359,7 @@ void
EXTEND(SV *obj, IV count)
CODE:
dTHXc;
- SV *sobj = S_sharedsv_from_obj(aTHX_ obj);
+ SV *sobj = SHAREDSV_FROM_OBJ(obj);
SHARED_EDIT;
av_extend((AV*)sobj, count);
SHARED_RELEASE;
@@ -1377,7 +1369,7 @@ void
STORESIZE(SV *obj,IV count)
CODE:
dTHXc;
- SV *sobj = S_sharedsv_from_obj(aTHX_ obj);
+ SV *sobj = SHAREDSV_FROM_OBJ(obj);
SHARED_EDIT;
av_fill((AV*) sobj, count);
SHARED_RELEASE;
@@ -1387,7 +1379,7 @@ void
EXISTS(SV *obj, SV *index)
CODE:
dTHXc;
- SV *sobj = S_sharedsv_from_obj(aTHX_ obj);
+ SV *sobj = SHAREDSV_FROM_OBJ(obj);
bool exists;
if (SvTYPE(sobj) == SVt_PVAV) {
SHARED_EDIT;
@@ -1412,7 +1404,7 @@ void
FIRSTKEY(SV *obj)
CODE:
dTHXc;
- SV *sobj = S_sharedsv_from_obj(aTHX_ obj);
+ SV *sobj = SHAREDSV_FROM_OBJ(obj);
char* key = NULL;
I32 len = 0;
HE* entry;
@@ -1437,7 +1429,7 @@ void
NEXTKEY(SV *obj, SV *oldkey)
CODE:
dTHXc;
- SV *sobj = S_sharedsv_from_obj(aTHX_ obj);
+ SV *sobj = SHAREDSV_FROM_OBJ(obj);
char* key = NULL;
I32 len = 0;
HE* entry;
diff --git a/dist/threads-shared/t/dualvar.t b/dist/threads-shared/t/dualvar.t
index 11d2cf4..cc8df21 100644
--- a/dist/threads-shared/t/dualvar.t
+++ b/dist/threads-shared/t/dualvar.t
@@ -13,7 +13,7 @@ use ExtUtils::testlib;
BEGIN {
$| = 1;
- print("1..219\n"); ### Number of tests that will be run ###
+ print("1..226\n"); ### Number of tests that will be run ###
}
use threads;
@@ -133,8 +133,6 @@ ok_uv($suv, $uv);
{
print("# Shared array element assignment - shared scalars\n");
- # FAILS
-
my @ary :shared;
$ary[0] = $siv;
$ary[1] = $snv;
@@ -419,9 +417,29 @@ ok_uv($suv, $uv);
ok_uv($$copy{'uv'}, $uv);
}
+print("# Mix it up with a thread\n");
+my @ary :shared;
+my %hsh :shared;
+
+threads->create(sub {
+ @ary = ($siv);
+ push(@ary, $snv);
+
+ %hsh = ( 'nv' => $ary[1] );
+ $hsh{'iv'} = $ary[0];
+ $hsh{'uv'} = $suv;
+
+ $ary[2] = $hsh{'uv'};
+ })->join();
+
+ok_iv($hsh{'iv'}, $ary[0]);
+ok_nv($hsh{'nv'}, $ary[1]);
+ok_uv($hsh{'uv'}, $ary[2]);
+
# $! behaves like a dualvar, but is really implemented as a tied SV.
# As a result sharing $! directly only propagates the string value.
# However, we can create a dualvar from it.
+print("# Errno\n");
$! = 1;
my $ss :shared = dualvar($!,$!);
ok_iv($ss, $!);
--
Perl5 Master Repository
