Add support for my $foo : shared;
[p5sagit/p5-mst-13.2.git] / ext / threads / shared / shared.xs
index 9d9d6d8..3ee7542 100644 (file)
@@ -452,7 +452,9 @@ int
 sharedsv_scalar_mg_free(pTHX_ SV *sv, MAGIC *mg)
 {
     shared_sv *shared = (shared_sv *) mg->mg_ptr;
+#if 0
     assert (SvREFCNT(SHAREDSvPTR(shared)) < 1000);
+#endif
     Perl_sharedsv_free(aTHX_ shared);
     return 0;
 }
@@ -460,7 +462,6 @@ sharedsv_scalar_mg_free(pTHX_ SV *sv, MAGIC *mg)
 int
 sharedsv_scalar_mg_clear(pTHX_ SV *sv, MAGIC *mg)
 {
-    shared_sv *shared = (shared_sv *) mg->mg_ptr;
     return 0;
 }
 
@@ -534,7 +535,6 @@ int
 sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg)
 {
     dTHXc;
-    bool allowed;
     shared_sv *shared = SV_to_sharedsv(aTHX_ mg->mg_obj);
     shared_sv *target;
     SV **svp;
@@ -571,7 +571,6 @@ sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg)
 {
     dTHXc;
     shared_sv *shared = SV_to_sharedsv(aTHX_ mg->mg_obj);
-    SV* ssv;
     ENTER_LOCK;
     sharedsv_elem_mg_FETCH(aTHX_ sv, mg);
     if (SvTYPE(SHAREDSvPTR(shared)) == SVt_PVAV) {
@@ -906,6 +905,20 @@ MODULE = threads::shared                PACKAGE = threads::shared
 PROTOTYPES: ENABLE
 
 void
+_id(SV *ref)
+       PROTOTYPE: \[$@%]
+CODE:
+       shared_sv *shared;
+       if(SvROK(ref))
+           ref = SvRV(ref);
+       if (shared = Perl_sharedsv_find(aTHX_ ref)) {
+           ST(0) = sv_2mortal(newSViv(PTR2IV(shared)));
+           XSRETURN(1);
+       }
+       XSRETURN_UNDEF;
+
+
+void
 _refcnt(SV *ref)
        PROTOTYPE: \[$@%]
 CODE: