X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=XS.xs;h=ac7503885effd58a96beaa5240a8938f91876185;hb=63c5566213607f2fabda8ab3c40021b1ca7deca8;hp=4fcd6e893de6386ef537d14e87d6607883b6bd3f;hpb=e290a0364d7a77719b5b46c59ad70f5be5b08076;p=gitmo%2FPackage-Stash-XS.git

diff --git a/XS.xs b/XS.xs
index 4fcd6e8..ac75038 100644
--- a/XS.xs
+++ b/XS.xs
@@ -28,6 +28,14 @@
 #define GvCV_set(gv, cv) (GvCV(gv) = (CV*)(cv))
 #endif
 
+#ifndef MUTABLE_PTR
+#define MUTABLE_PTR(p) ((void *) (p))
+#endif
+
+#ifndef MUTABLE_SV
+#define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
+#endif
+
 #ifndef SVT_SCALAR
 #define SVT_SCALAR(svt) (svt <= SVt_PVLV)
 #endif
@@ -324,18 +332,64 @@ static SV *_get_name(SV *self)
     return ret;
 }
 
+static void _real_gv_init(GV *gv, HV *stash, SV *name)
+{
+    char *name_pv;
+    STRLEN name_len;
+
+    name_pv = SvPV(name, name_len);
+    gv_init(gv, stash, name_pv, name_len, 1);
+
+    /* XXX: copied and pasted from gv_fetchpvn_flags and such */
+    /* ignoring the stuff for CORE:: and main:: for now, and also
+     * ignoring the GvMULTI_on bits, since we pass 1 to gv_init above */
+    switch (name_pv[0]) {
+        case 'I':
+            if (strEQ(&name_pv[1], "SA")) {
+                AV *av;
+
+                av = GvAVn(gv);
+                sv_magic(MUTABLE_SV(av), MUTABLE_SV(gv), PERL_MAGIC_isa,
+                        NULL, 0);
+            }
+            break;
+        case 'O':
+            if (strEQ(&name_pv[1], "VERLOAD")) {
+                HV *hv;
+
+                hv = GvHVn(gv);
+                hv_magic(hv, NULL, PERL_MAGIC_overload);
+            }
+            break;
+        default:
+            break;
+    }
+}
+
 static void _expand_glob(SV *self, SV *varname)
 {
-    SV *name;
+    HV *namespace;
+    HE *entry;
+    GV *glob;
 
-    name = newSVsv(_get_name(self));
-    sv_catpvs(name, "::");
-    sv_catsv(name, varname);
+    namespace = _get_namespace(self);
 
-    /* can't use gv_init here, because it screws up @ISA in a way that I
-     * can't reproduce, but that CMOP triggers */
-    gv_fetchsv(name, GV_ADD, SVt_NULL);
-    SvREFCNT_dec(name);
+    if (entry = hv_fetch_ent(namespace, varname, 0, 0)) {
+        glob = (GV*)HeVAL(entry);
+        if (isGV(glob)) {
+            croak("_expand_glob called on stash slot with expanded glob");
+        }
+        else {
+            SvREFCNT_inc(glob);
+            _real_gv_init(glob, namespace, varname);
+            if (!hv_store_ent(namespace, varname, (SV*)glob, 0)) {
+                croak("hv_store failed");
+            }
+        }
+    }
+    else {
+        croak("_expand_glob called on nonexistent stash slot");
+    }
 }
 
 static SV *_get_symbol(SV *self, varspec_t *variable, int vivify)
@@ -567,7 +621,7 @@ add_symbol(self, variable, initial=NULL, ...)
     }
     else {
         glob = (GV*)newSV(0);
-        gv_init(glob, namespace, "ANON", 4, 1);
+        _real_gv_init(glob, namespace, variable.name);
         if (!hv_store_ent(namespace, variable.name, (SV*)glob, 0)) {
             croak("hv_store failed");
         }