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 (file)
--- 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 (file)
--- 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");
+
+