Fix up .gitignore files some more

[p5sagit/p5-mst-13.2.git] / ext / threads / shared / shared.xs

diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs
index 9e66dfa..b9a3241 100644 (file)
--- a/ext/threads/shared/shared.xs
+++ b/ext/threads/shared/shared.xs
@@ -123,6 +123,7 @@
 #  define NEED_sv_2pv_flags
 #  define NEED_vnewSVpvf
 #  define NEED_warner
+#  define NEED_newSVpvn_flags
 #  include "ppport.h"
 #  include "shared.h"
 #endif
@@ -712,6 +713,11 @@ sharedsv_scalar_mg_get(pTHX_ SV *sv, MAGIC *mg)
     ENTER_LOCK;
     if (SvROK(ssv)) {
         S_get_RV(aTHX_ sv, ssv);
+        /* Look ahead for refs of refs */
+        if (SvROK(SvRV(ssv))) {
+            SvROK_on(SvRV(sv));
+            S_get_RV(aTHX_ SvRV(sv), SvRV(ssv));
+        }
     } else {
         sv_setsv_nomg(sv, ssv);
     }
@@ -867,10 +873,15 @@ sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg)
         svp = av_fetch((AV*) saggregate, mg->mg_len, 0);
     } else {
         char *key = mg->mg_ptr;
-        STRLEN len = mg->mg_len;
+        I32 len = mg->mg_len;
         assert ( mg->mg_ptr != 0 );
         if (mg->mg_len == HEf_SVKEY) {
-           key = SvPV((SV *) mg->mg_ptr, len);
+            STRLEN slen;
+            key = SvPV((SV *)mg->mg_ptr, slen);
+            len = slen;
+            if (SvUTF8((SV *)mg->mg_ptr)) {
+                len = -len;
+            }
         }
         SHARED_CONTEXT;
         svp = hv_fetch((HV*) saggregate, key, len, 0);
@@ -880,9 +891,13 @@ sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg)
         /* Exists in the array */
         if (SvROK(*svp)) {
             S_get_RV(aTHX_ sv, *svp);
+            /* Look ahead for refs of refs */
+            if (SvROK(SvRV(*svp))) {
+                SvROK_on(SvRV(sv));
+                S_get_RV(aTHX_ SvRV(sv), SvRV(*svp));
+            }
         } else {
-            /* XXX Can this branch ever happen? DAPM */
-            /* XXX assert("no such branch"); */
+            /* $ary->[elem] or $ary->{elem} is a scalar */
             Perl_sharedsv_associate(aTHX_ sv, *svp);
             sv_setsv(sv, *svp);
         }
@@ -914,10 +929,16 @@ sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg)
         svp = av_fetch((AV*) saggregate, mg->mg_len, 1);
     } else {
         char *key = mg->mg_ptr;
-        STRLEN len = mg->mg_len;
+        I32 len = mg->mg_len;
         assert ( mg->mg_ptr != 0 );
-        if (mg->mg_len == HEf_SVKEY)
-           key = SvPV((SV *) mg->mg_ptr, len);
+        if (mg->mg_len == HEf_SVKEY) {
+            STRLEN slen;
+            key = SvPV((SV *)mg->mg_ptr, slen);
+            len = slen;
+            if (SvUTF8((SV *)mg->mg_ptr)) {
+                len = -len;
+            }
+        }
         SHARED_CONTEXT;
         svp = hv_fetch((HV*) saggregate, key, len, 1);
     }
@@ -945,10 +966,16 @@ sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg)
         av_delete((AV*) saggregate, mg->mg_len, G_DISCARD);
     } else {
         char *key = mg->mg_ptr;
-        STRLEN len = mg->mg_len;
+        I32 len = mg->mg_len;
         assert ( mg->mg_ptr != 0 );
-        if (mg->mg_len == HEf_SVKEY)
-           key = SvPV((SV *) mg->mg_ptr, len);
+        if (mg->mg_len == HEf_SVKEY) {
+            STRLEN slen;
+            key = SvPV((SV *)mg->mg_ptr, slen);
+            len = slen;
+            if (SvUTF8((SV *)mg->mg_ptr)) {
+                len = -len;
+            }
+        }
         SHARED_CONTEXT;
         hv_delete((HV*) saggregate, key, len, G_DISCARD);
     }
@@ -1033,9 +1060,15 @@ sharedsv_array_mg_free(pTHX_ SV *sv, MAGIC *mg)
  * This is called when perl is about to access an element of
  * the array -
  */
+#if PERL_VERSION >= 11
+int
+sharedsv_array_mg_copy(pTHX_ SV *sv, MAGIC* mg,
+                       SV *nsv, const char *name, I32 namlen)
+#else
 int
 sharedsv_array_mg_copy(pTHX_ SV *sv, MAGIC* mg,
                        SV *nsv, const char *name, int namlen)
+#endif
 {
     MAGIC *nmg = sv_magicext(nsv,mg->mg_obj,
                             toLOWER(mg->mg_type),&sharedsv_elem_vtbl,
@@ -1259,8 +1292,13 @@ EXISTS(SV *obj, SV *index)
             SHARED_EDIT;
             exists = av_exists((AV*) sobj, SvIV(index));
         } else {
-            STRLEN len;
-            char *key = SvPV(index,len);
+            I32 len;
+            STRLEN slen;
+            char *key = SvPVutf8(index, slen);
+            len = slen;
+            if (SvUTF8(index)) {
+                len = -len;
+            }
             SHARED_EDIT;
             exists = hv_exists((HV*) sobj, key, len);
         }
@@ -1282,9 +1320,10 @@ FIRSTKEY(SV *obj)
         hv_iterinit((HV*) sobj);
         entry = hv_iternext((HV*) sobj);
         if (entry) {
+            I32 utf8 = HeKUTF8(entry);
             key = hv_iterkey(entry,&len);
             CALLER_CONTEXT;
-            ST(0) = sv_2mortal(newSVpv(key, len));
+            ST(0) = sv_2mortal(newSVpvn_utf8(key, len, utf8));
         } else {
             CALLER_CONTEXT;
             ST(0) = &PL_sv_undef;
@@ -1308,9 +1347,10 @@ NEXTKEY(SV *obj, SV *oldkey)
         SHARED_CONTEXT;
         entry = hv_iternext((HV*) sobj);
         if (entry) {
+            I32 utf8 = HeKUTF8(entry);
             key = hv_iterkey(entry,&len);
             CALLER_CONTEXT;
-            ST(0) = sv_2mortal(newSVpv(key, len));
+            ST(0) = sv_2mortal(newSVpvn_utf8(key, len, utf8));
         } else {
             CALLER_CONTEXT;
             ST(0) = &PL_sv_undef;
@@ -1330,6 +1370,8 @@ _id(SV *myref)
         SV *ssv;
     CODE:
         myref = SvRV(myref);
+        if (SvMAGICAL(myref))
+            mg_get(myref);
         if (SvROK(myref))
             myref = SvRV(myref);
         ssv = Perl_sharedsv_find(aTHX_ myref);