changelog

[gitmo/Package-Stash-XS.git] / XS.xs

diff --git a/XS.xs b/XS.xs
index a32ca45..8c84081 100644 (file)
--- a/XS.xs
+++ b/XS.xs
@@ -24,6 +24,34 @@
 #define savesvpv(s) savepv(SvPV_nolen(s))
 #endif
 
+#ifndef GvCV_set
+#define GvCV_set(gv, cv) (GvCV(gv) = (CV*)(cv))
+#endif
+
+#ifndef SVT_SCALAR
+#define SVT_SCALAR(svt) (svt <= SVt_PVLV)
+#endif
+
+#ifndef SVT_ARRAY
+#define SVT_ARRAY(svt) (svt == SVt_PVAV)
+#endif
+
+#ifndef SVT_HASH
+#define SVT_HASH(svt) (svt == SVt_PVHV)
+#endif
+
+#ifndef SVT_CODE
+#define SVT_CODE(svt) (svt == SVt_PVCV)
+#endif
+
+#ifndef SVT_IO
+#define SVT_IO(svt) (svt == SVt_PVIO)
+#endif
+
+#ifndef SVT_FORMAT
+#define SVT_FORMAT(svt) (svt == SVt_PVFM)
+#endif
+
 /* HACK: scalar slots are always populated on perl < 5.10, so treat undef
  * as nonexistent. this is consistent with the previous behavior of the pure
  * perl version of this module (since this is the behavior that perl sees
@@ -68,7 +96,7 @@
 } while (0)
 #define GvSetCV(g,v) do {               \
     SvREFCNT_dec(GvCV(g));              \
-    if ((GvCV(g) = (CV*)(v))) {         \
+    if ((GvCV_set(g, v))) {             \
         GvIMPORTED_CV_on(g);            \
         GvASSUMECV_on(g);               \
     }                                   \
@@ -99,7 +127,7 @@ typedef struct {
 static U32 name_hash, namespace_hash, type_hash;
 static SV *name_key, *namespace_key, *type_key;
 
-const char *vartype_to_string(vartype_t type)
+static const char *vartype_to_string(vartype_t type)
 {
     switch (type) {
     case VAR_SCALAR:
@@ -117,7 +145,7 @@ const char *vartype_to_string(vartype_t type)
     }
 }
 
-I32 vartype_to_svtype(vartype_t type)
+static I32 vartype_to_svtype(vartype_t type)
 {
     switch (type) {
     case VAR_SCALAR:
@@ -135,7 +163,7 @@ I32 vartype_to_svtype(vartype_t type)
     }
 }
 
-vartype_t string_to_vartype(char *vartype)
+static vartype_t string_to_vartype(char *vartype)
 {
     if (strEQ(vartype, "SCALAR")) {
         return VAR_SCALAR;
@@ -157,7 +185,7 @@ vartype_t string_to_vartype(char *vartype)
     }
 }
 
-void _deconstruct_variable_name(SV *variable, varspec_t *varspec)
+static void _deconstruct_variable_name(SV *variable, varspec_t *varspec)
 {
     char *varpv;
 
@@ -190,7 +218,7 @@ void _deconstruct_variable_name(SV *variable, varspec_t *varspec)
     }
 }
 
-void _deconstruct_variable_hash(HV *variable, varspec_t *varspec)
+static void _deconstruct_variable_hash(HV *variable, varspec_t *varspec)
 {
     HE *val;
 
@@ -207,27 +235,31 @@ void _deconstruct_variable_hash(HV *variable, varspec_t *varspec)
     varspec->type = string_to_vartype(SvPV_nolen(HeVAL(val)));
 }
 
-int _valid_for_type(SV *value, vartype_t type)
+static int _valid_for_type(SV *value, vartype_t type)
 {
     svtype sv_type = SvROK(value) ? SvTYPE(SvRV(value)) : SVt_NULL;
 
     switch (type) {
     case VAR_SCALAR:
-        return SvROK(value) ? SvOK(SvRV(value)) : SvOK(value);
+        /* XXX is a glob a scalar? assigning a glob to the scalar slot seems
+         * to work here, but in pure perl i'm pretty sure it goes to the EGV
+         * slot, which seems more correct to me. just disable it for now
+         * i guess */
+        return SVT_SCALAR(sv_type) && sv_type != SVt_PVGV;
     case VAR_ARRAY:
-        return sv_type == SVt_PVAV;
+        return SVT_ARRAY(sv_type);
     case VAR_HASH:
-        return sv_type == SVt_PVHV;
+        return SVT_HASH(sv_type);
     case VAR_CODE:
-        return sv_type == SVt_PVCV;
+        return SVT_CODE(sv_type);
     case VAR_IO:
-        return sv_type == SVt_PVIO;
+        return SVT_IO(sv_type);
     default:
         return 0;
     }
 }
 
-HV *_get_namespace(SV *self)
+static HV *_get_namespace(SV *self)
 {
     dSP;
     SV *ret;
@@ -245,7 +277,7 @@ HV *_get_namespace(SV *self)
     return (HV*)SvRV(ret);
 }
 
-SV *_get_name(SV *self)
+static SV *_get_name(SV *self)
 {
     dSP;
     SV *ret;
@@ -263,7 +295,7 @@ SV *_get_name(SV *self)
     return ret;
 }
 
-void _expand_glob(SV *self, SV *varname)
+static void _expand_glob(SV *self, SV *varname)
 {
     SV *name;
 
@@ -277,7 +309,7 @@ void _expand_glob(SV *self, SV *varname)
     SvREFCNT_dec(name);
 }
 
-SV *_get_symbol(SV *self, varspec_t *variable, int vivify)
+static SV *_get_symbol(SV *self, varspec_t *variable, int vivify)
 {
     HV *namespace;
     HE *entry;
@@ -343,8 +375,6 @@ new(class, package_name)
     SV *package_name
   PREINIT:
     HV *instance;
-    HV *namespace;
-    SV *nsref;
   CODE:
     if (!SvPOK(package_name))
         croak("The constructor argument must be the name of a package");
@@ -356,13 +386,6 @@ new(class, package_name)
         SvREFCNT_dec(instance);
         croak("Couldn't initialize the 'name' key, hv_store failed");
     }
-    namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
-    nsref = newRV_inc((SV*)namespace);
-    if (!hv_store(instance, "namespace", 9, nsref, 0)) {
-        SvREFCNT_dec(nsref);
-        SvREFCNT_dec(instance);
-        croak("Couldn't initialize the 'namespace' key, hv_store failed");
-    }
 
     RETVAL = sv_bless(newRV_noinc((SV*)instance), gv_stashsv(class, 0));
   OUTPUT:
@@ -386,11 +409,34 @@ namespace(self)
     SV *self
   PREINIT:
     HE *slot;
+    SV *package_name;
   CODE:
     if (!sv_isobject(self))
         croak("Can't call namespace as a class method");
+#if PERL_VERSION < 10
+    package_name = _get_name(self);
+    RETVAL = newRV_inc((SV*)gv_stashpv(SvPV_nolen(package_name), GV_ADD));
+#else
     slot = hv_fetch_ent((HV*)SvRV(self), namespace_key, 0, namespace_hash);
-    RETVAL = slot ? SvREFCNT_inc_simple_NN(HeVAL(slot)) : &PL_sv_undef;
+    if (slot) {
+        RETVAL = SvREFCNT_inc_simple_NN(HeVAL(slot));
+    }
+    else {
+        HV *namespace;
+        SV *nsref;
+
+        package_name = _get_name(self);
+        namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
+        nsref = newRV_inc((SV*)namespace);
+        sv_rvweaken(nsref);
+        if (!hv_store((HV*)SvRV(self), "namespace", 9, nsref, 0)) {
+            SvREFCNT_dec(nsref);
+            SvREFCNT_dec(self);
+            croak("Couldn't initialize the 'namespace' key, hv_store failed");
+        }
+        RETVAL = SvREFCNT_inc_simple_NN(nsref);
+    }
+#endif
   OUTPUT:
     RETVAL
 
@@ -415,7 +461,6 @@ add_symbol(self, variable, initial=NULL, ...)
         int i;
         char *filename = NULL;
         I32 first_line_num = -1, last_line_num = -1;
-        STRLEN namelen;
         SV *dbval;
         HV *dbsub;