From: Artur Bergman <sky@nanisky.com>
Date: Fri, 26 Oct 2001 11:15:28 +0000 (+0000)
Subject: Fix case where shared reference does not exist in current thread.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=409b1fd3668e7a4d9e663c5b16ba2364947b127b;p=p5sagit%2Fp5-mst-13.2.git

Fix case where shared reference does not exist in current thread.

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

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index 3fe8256..ed5ddfd 100644
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -3,6 +3,7 @@
 #include "perl.h"
 #include "XSUB.h"
 
+MGVTBL svtable;
 
 SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
     HV* shared_hv = get_hv("threads::shared::shared", FALSE);
@@ -19,7 +20,26 @@ SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
 	    sv = newRV(SvRV(tiedobject));
 	}
     } else {
-        croak("die\n");
+	switch(SvTYPE(SHAREDSvGET(shared))) {
+	    default: {
+	        MAGIC* shared_magic;
+		SV* value = newSVsv(SHAREDSvGET(shared));
+	        SV* obj = newSViv((IV)shared);
+        	sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
+        	shared_magic = mg_find(value, PERL_MAGIC_ext);
+        	shared_magic->mg_virtual = &svtable;
+        	shared_magic->mg_obj = newSViv((IV)shared);
+        	shared_magic->mg_flags |= MGf_REFCOUNTED;
+        	shared_magic->mg_private = 0;
+        	SvMAGICAL_on(value);
+	        sv = newRV_noinc(value);
+	        value = newRV(value);
+ 		sv_rvweaken(value);
+	        hv_store(shared_hv, SvPV(id,length),length, value, 0);
+		Perl_sharedsv_thrcnt_inc(aTHX_ shared);
+	    }
+	    	
+	}
     }
     return sv;
 }
@@ -74,6 +94,12 @@ int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
     shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
     if(!shared) 
         return 0;
+    {
+	HV* shared_hv = get_hv("threads::shared::shared", FALSE);
+        SV* id = newSViv((IV)shared);
+        STRLEN length = sv_len(id);
+        hv_delete(shared_hv, SvPV(id,length), length,0);
+    }
     Perl_sharedsv_thrcnt_dec(aTHX_ shared);
 }
 
@@ -504,14 +530,16 @@ STORE(self, key, value)
         SV** hentry_;
 	STRLEN len;
 	char* ckey = SvPV(key, len);
+        SHAREDSvLOCK(shared);
 	if(SvROK(value)) {
 	    shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
 	    if(!target) {
 		Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
             }
+	    SHAREDSvEDIT(shared);
 	    value = newRV_noinc(newSViv((IV)target));
+	    SHAREDSvRELEASE(shared);
 	}
-        SHAREDSvLOCK(shared);
         hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
         if(hentry_ && SvIV((*hentry_))) {
             hentry = (*hentry_);
diff --git a/ext/threads/shared/t/hv_refs.t b/ext/threads/shared/t/hv_refs.t
index 53029bf..5181dbd 100644
--- a/ext/threads/shared/t/hv_refs.t
+++ b/ext/threads/shared/t/hv_refs.t
@@ -42,3 +42,21 @@ ok(5, threads::shared::_thrcnt($foo) == 2, "Check refcount");
 my $bar = delete($foo{foo});
 ok(6, $$bar eq "test2", "check delete");
 ok(7, threads::shared::_thrcnt($foo) == 1, "Check refcount after delete");
+threads->create( sub {
+my $test;
+share($test);
+$test = "thread3";
+$foo{test} = \$test;
+})->join();
+ok(8, ${$foo{test}} eq "thread3", "Check refernece created in another thread");
+my $gg = $foo{test};
+$$gg = "test";
+ok(9, ${$foo{test}} eq "test", "Check refernece");
+ok(10, threads::shared::_thrcnt($gg) == 2, "Check refcount");
+my $gg2 = delete($foo{test});
+ok(11, threads::shared::_thrcnt($gg) == 1, "Check refcount");
+ok(12, $gg == $gg2, "Check we get the same reference ($gg == $gg2)");
+ok(13, $$gg eq $$gg2, "And check the values are the same");
+ok(14, keys %foo == 0, "And make sure we realy have deleted the values");
+
+