Change 19715: Support blessed shared references.

[Arthur Bergman]

Change 19715 by sky@sky-marlin on 2003/06/09 09:35:47

Support blessed shared references.

Affected files ...

... //depot/perl/ext/threads/shared/shared.pm#32 edit
... //depot/perl/ext/threads/shared/shared.xs#34 edit
... //depot/perl/ext/threads/shared/t/hv_refs.t#9 edit

Differences ...

==== //depot/perl/ext/threads/shared/shared.pm#32 (text) ====
Index: perl/ext/threads/shared/shared.pm
--- perl/ext/threads/shared/shared.pm#31~18707~ Fri Feb 14 22:38:15 2003
+++ perl/ext/threads/shared/shared.pm Mon Jun 9 02:35:47 2003
@@ -3,24 +3,26 @@
use 5.007_003;
use strict;
use warnings;
+BEGIN {
+ require Exporter;
+ our @ISA = qw(Exporter);
+ our @EXPORT = qw(share cond_wait cond_broadcast cond_signal);
+ our $VERSION = '0.90';

-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT = qw(share cond_wait cond_broadcast cond_signal);
-our $VERSION = '0.90';
-
-if ($threads::threads) {
+ if ($threads::threads) {
*cond_wait = \&cond_wait_enabled;
*cond_signal = \&cond_signal_enabled;
*cond_broadcast = \&cond_broadcast_enabled;
require XSLoader;
XSLoader::load('threads::shared',$VERSION);
-}
-else {
+ push @EXPORT,'bless';
+ }
+ else {
*share = \&share_disabled;
*cond_wait = \&cond_wait_disabled;
*cond_signal = \&cond_signal_disabled;
*cond_broadcast = \&cond_broadcast_disabled;
+ }
}

==== //depot/perl/ext/threads/shared/shared.xs#34 (text) ====
Index: perl/ext/threads/shared/shared.xs
--- perl/ext/threads/shared/shared.xs#33~19299~ Mon Apr 21 10:05:31 2003
+++ perl/ext/threads/shared/shared.xs Mon Jun 9 02:35:47 2003
@@ -329,6 +329,13 @@
mg->mg_flags |= (MGf_COPY|MGf_DUP);
SvREFCNT_inc(ssv);
SvREFCNT_dec(obj);
+ if(SvOBJECT(ssv)) {
+ STRLEN len;
+ char* stash_ptr = SvPV((SV*) SvSTASH(ssv), len);
+ HV* stash = gv_stashpvn(stash_ptr, len, TRUE);
+ SvOBJECT_on(sv);
+ SvSTASH(sv) = (HV*)SvREFCNT_inc(stash);
+ }
}
break;

@@ -400,6 +407,7 @@
sv_setsv_nomg(sv, &PL_sv_undef);
SvRV(sv) = obj;
SvROK_on(sv);
+
}
else {
sv_setsv_nomg(sv, SHAREDSvPTR(shared));
@@ -422,6 +430,11 @@
tmp = newRV(SHAREDSvPTR(target));
sv_setsv_nomg(SHAREDSvPTR(shared), tmp);
SvREFCNT_dec(tmp);
+ if(SvOBJECT(SvRV(sv))) {
+ SV* fake_stash = newSVpv(HvNAME(SvSTASH(SvRV(sv))),0);
+ SvOBJECT_on(SHAREDSvPTR(target));
+ SvSTASH(SHAREDSvPTR(target)) = (HV*)fake_stash;
+ }
CALLER_CONTEXT;
}
else {
@@ -429,9 +442,14 @@
}
}
else {
- SvTEMP_off(sv);
+ SvTEMP_off(sv);
SHARED_CONTEXT;
sv_setsv_nomg(SHAREDSvPTR(shared), sv);
+ if(SvOBJECT(sv)) {
+ SV* fake_stash = newSVpv(HvNAME(SvSTASH(sv)),0);
+ SvOBJECT_on(SHAREDSvPTR(shared));
+ SvSTASH(SHAREDSvPTR(shared)) = (HV*)fake_stash;
+ }
CALLER_CONTEXT;
}
if (!allowed) {
@@ -1058,6 +1076,48 @@
Perl_warner(aTHX_ packWARN(WARN_THREADS),
"cond_broadcast() called on unlocked variable");
COND_BROADCAST(&shared->user_cond);
+
+
+SV*
+bless(SV* ref, ...);
+ PROTOTYPE: $;$
+ CODE:
+ {
+ HV* stash;
+ shared_sv* shared;
+ if (items == 1)
+ stash = CopSTASH(PL_curcop);
+ else {
+ SV* ssv = ST(1);
+ STRLEN len;
+ char *ptr;
+
+ if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
+ Perl_croak(aTHX_ "Attempt to bless into a reference");
+ ptr = SvPV(ssv,len);
+ if (ckWARN(WARN_MISC) && len == 0)
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
+ "Explicit blessing to '' (assuming package main)");
+ stash = gv_stashpvn(ptr, len, TRUE);
+ }
+ SvREFCNT_inc(ref);
+ (void)sv_bless(ref, stash);
+ RETVAL = ref;
+ shared = Perl_sharedsv_find(aTHX_ ref);
+ if(shared) {
+ dTHXc;
+ ENTER_LOCK;
+ SHARED_CONTEXT;
+ {
+ SV* fake_stash = newSVpv(HvNAME(stash),0);
+ (void)sv_bless(SHAREDSvPTR(shared),(HV*)fake_stash);
+ }
+ CALLER_CONTEXT;
+ LEAVE_LOCK;
+ }
+ }
+ OUTPUT:
+ RETVAL

#endif /* USE_ITHREADS */

==== //depot/perl/ext/threads/shared/t/hv_refs.t#9 (text) ====
Index: perl/ext/threads/shared/t/hv_refs.t
--- perl/ext/threads/shared/t/hv_refs.t#8~18413~ Fri Jan 3 07:15:14 2003
+++ perl/ext/threads/shared/t/hv_refs.t Mon Jun 9 02:35:47 2003
@@ -30,7 +30,7 @@

use ExtUtils::testlib;
use strict;
-BEGIN { print "1..14\n" };
+BEGIN { print "1..17\n" };
use threads;
use threads::shared;
ok(1,1,"loaded");
@@ -84,7 +84,15 @@
ok(14, 1, "lock on helems now work, this was bug 10045");

}
-
+{
+ my $object : shared = &share({});
+ threads->new(sub { bless $object, 'test1' });
+ ok(15, ref($object) eq 'test1', "blessing does work");
+ my %test = (object => $object);
+ ok(16, ref($test{object}) eq 'test1', "and some more work");
+ bless $object, 'test2';
+ ok(17, ref($test{object}) eq 'test2', "reblessing works!");
+}



End of Patch.