From: Artur Bergman <sky@nanisky.com>
Date: Mon, 9 Jun 2003 09:35:47 +0000 (+0000)
Subject: Support blessed shared references.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5c360ac576a2bcf18ac7d94918a700da7abf2c22;p=p5sagit%2Fp5-mst-13.2.git

Support blessed shared references.

p4raw-id: //depot/perl@19715
---

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index c8d72e5..64ab079 100644
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -3,24 +3,26 @@ package threads::shared;
 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;
+    }
 }
 
 
diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index 9e0f73b..8fe678d 100644
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -329,6 +329,13 @@ Perl_sharedsv_associate(pTHX_ SV **psv, SV *ssv, shared_sv *data)
 		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 @@ sharedsv_scalar_mg_get(pTHX_ SV *sv, MAGIC *mg)
 	    sv_setsv_nomg(sv, &PL_sv_undef);
 	    SvRV(sv) = obj;
 	    SvROK_on(sv);
+	    
 	}
 	else {
 	    sv_setsv_nomg(sv, SHAREDSvPTR(shared));
@@ -422,6 +430,11 @@ sharedsv_scalar_store(pTHX_ SV *sv, shared_sv *shared)
 	    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 @@ sharedsv_scalar_store(pTHX_ SV *sv, shared_sv *shared)
 	}
     }
     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) {
@@ -1059,6 +1077,48 @@ cond_broadcast_enabled(SV *ref)
 			    "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 */
 
 BOOT:
diff --git a/ext/threads/shared/t/hv_refs.t b/ext/threads/shared/t/hv_refs.t
index fb3c8de..66df0a6 100644
--- a/ext/threads/shared/t/hv_refs.t
+++ b/ext/threads/shared/t/hv_refs.t
@@ -30,7 +30,7 @@ sub skip {
 
 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(10, keys %foo == 0, "And make sure we realy have deleted the values");
   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!");
+}