X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=autovivification.xs;h=9884389bd99370dd398e8a812bfd88e6172d4bcf;hb=aae04e46de5be0dc7e9abfc02035b6bb09aea6a7;hp=eb1cbbcad762d48e209de8f40048ef578ba6f24a;hpb=32f02f03f98df22086b067e5e81be90c1f83d030;p=perl%2Fmodules%2Fautovivification.git

diff --git a/autovivification.xs b/autovivification.xs
index eb1cbbc..9884389 100644
--- a/autovivification.xs
+++ b/autovivification.xs
@@ -41,6 +41,49 @@
 # endif
 #endif
 
+/* ... Our vivify_ref() .................................................... */
+
+/* Perl_vivify_ref() is not exported, so we have to reimplement it. */
+
+#if A_HAS_MULTIDEREF
+
+static SV *a_vivify_ref(pTHX_ SV *sv, int to_hash) {
+#define a_vivify_ref(S, TH) a_vivify_ref(aTHX_ (S), (TH))
+ SvGETMAGIC(sv);
+
+ if (!SvOK(sv)) {
+  SV *val;
+
+  if (SvREADONLY(sv))
+   Perl_croak_no_modify();
+
+  /* Inlined prepare_SV_for_RV() */
+  if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV) {
+   sv_upgrade(sv, SVt_IV);
+  } else if (SvTYPE(sv) >= SVt_PV) {
+   SvPV_free(sv);
+   SvLEN_set(sv, 0);
+   SvCUR_set(sv, 0);
+  }
+
+  val = to_hash ? MUTABLE_SV(newHV()) : MUTABLE_SV(newAV());
+  SvRV_set(sv, val);
+  SvROK_on(sv);
+  SvSETMAGIC(sv);
+  SvGETMAGIC(sv);
+ }
+
+ if (SvGMAGICAL(sv)) {
+  SV *msv = sv_newmortal();
+  sv_setsv_nomg(msv, sv);
+  return msv;
+ }
+
+ return sv;
+}
+
+#endif /* A_HAS_MULTIDEREF */
+
 /* ... Thread safety and multiplicity ...................................... */
 
 /* Always safe when the workaround isn't needed */
@@ -491,6 +534,7 @@ typedef struct {
 /* PerlMemShared_free() needs the [ap]PTBLMS_? default values */
 #define ptable_map_store(T, K, V) ptable_map_store(aPTBLMS_ (T), (K), (V))
 #define ptable_map_delete(T, K)   ptable_map_delete(aPTBLMS_ (T), (K))
+#define ptable_map_free(T)        ptable_map_free(aPTBLMS_ (T))
 
 static ptable *a_op_map = NULL;
 
@@ -1025,7 +1069,7 @@ static OP *a_pp_multideref(pTHX) {
     if (a_undef(sv))
      goto ret_undef;
 do_AV_vivify_rv2av_aelem:
-    sv = Perl_vivify_ref(aTHX_ sv, OPpDEREF_AV);
+    sv = a_vivify_ref(sv, 0);
 do_AV_rv2av_aelem:
     sv = a_do_pp_rv2av(sv);
 do_AV_aelem:
@@ -1104,7 +1148,7 @@ check_elem:
     if (a_undef(sv))
      goto ret_undef;
 do_HV_vivify_rv2hv_helem:
-    sv = Perl_vivify_ref(aTHX_ sv, OPpDEREF_HV);
+    sv = a_vivify_ref(sv, 1);
 do_HV_rv2hv_helem:
     sv = a_do_pp_rv2hv(sv);
 do_HV_helem:
@@ -1569,6 +1613,10 @@ static void a_teardown(pTHX_ void *root) {
 
   ptable_map_free(a_op_map);
   a_op_map = NULL;
+
+#ifdef USE_ITHREADS
+  MUTEX_DESTROY(&a_op_map_mutex);
+#endif
  }
 
  A_LOADED_UNLOCK;
@@ -1603,6 +1651,7 @@ static void a_setup(pTHX) {
   PERL_HASH(a_hash, __PACKAGE__, __PACKAGE_LEN__);
 
   a_op_map = ptable_new();
+
 #ifdef USE_ITHREADS
   MUTEX_INIT(&a_op_map_mutex);
 #endif