clean up glob manipulation code, and hack around a 5.8 issue

diff --git a/Stash.xs b/Stash.xs
index c2a4229..0ff9d32 100644 (file)
--- a/Stash.xs
+++ b/Stash.xs
@@ -24,6 +24,50 @@
 #define savesvpv(s) savepv(SvPV_nolen(s))
 #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
+ * in all versions */
+#if PERL_VERSION < 10
+#define GvSVOK(g) (GvSV(g) && SvTYPE(GvSV(g)) != SVt_NULL)
+#else
+#define GvSVOK(g) GvSV(g)
+#endif
+
+#define GvAVOK(g) GvAV(g)
+#define GvHVOK(g) GvHV(g)
+#define GvCVOK(g) GvCVu(g) /* XXX: should this really be GvCVu? or GvCV? */
+#define GvIOOK(g) GvIO(g)
+
+#define GvSetSV(g,v) do {               \
+    SvREFCNT_dec(GvSV(g));              \
+    if ((GvSV(g) = (SV*)(v)))           \
+        GvIMPORTED_SV_on(g);            \
+} while (0)
+#define GvSetAV(g,v) do {               \
+    SvREFCNT_dec(GvAV(g));              \
+    if ((GvAV(g) = (AV*)(v)))           \
+        GvIMPORTED_AV_on(g);            \
+} while (0)
+#define GvSetHV(g,v) do {               \
+    SvREFCNT_dec(GvHV(g));              \
+    if ((GvHV(g) = (HV*)(v)))           \
+        GvIMPORTED_HV_on(g);            \
+} while (0)
+#define GvSetCV(g,v) do {               \
+    SvREFCNT_dec(GvCV(g));              \
+    if ((GvCV(g) = (CV*)(v))) {         \
+        GvIMPORTED_CV_on(g);            \
+        GvASSUMECV_on(g);               \
+    }                                   \
+    GvCVGEN(g) = 0;                     \
+    mro_method_changed_in(GvSTASH(g));  \
+} while (0)
+#define GvSetIO(g,v) do {               \
+    SvREFCNT_dec(GvIO(g));              \
+    GvIOp(g) = (IO*)(v);                \
+} while (0)
+
 typedef enum {
     VAR_NONE = 0,
     VAR_SCALAR,
@@ -244,22 +288,22 @@ SV *_get_symbol(SV *self, varspec_t *variable, int vivify)
     if (vivify) {
         switch (variable->type) {
         case VAR_SCALAR:
-            if (!GvSV(glob))
-                GvSV(glob) = newSV(0);
+            if (!GvSVOK(glob))
+                GvSetSV(glob, newSV(0));
             break;
         case VAR_ARRAY:
-            if (!GvAV(glob))
-                GvAV(glob) = newAV();
+            if (!GvAVOK(glob))
+                GvSetAV(glob, newAV());
             break;
         case VAR_HASH:
-            if (!GvHV(glob))
-                GvHV(glob) = newHV();
+            if (!GvHVOK(glob))
+                GvSetHV(glob, newHV());
             break;
         case VAR_CODE:
             croak("Don't know how to vivify CODE variables");
         case VAR_IO:
-            if (!GvIO(glob))
-                GvIOp(glob) = newIO();
+            if (!GvIOOK(glob))
+                GvSetIO(glob, newIO());
             break;
         default:
             croak("Unknown type in vivication");
@@ -422,31 +466,19 @@ add_symbol(self, variable, initial=NULL, ...)
 
         switch (variable.type) {
         case VAR_SCALAR:
-            SvREFCNT_dec(GvSV(glob));
-            GvSV(glob) = val;
-            GvIMPORTED_SV_on(glob);
+            GvSetSV(glob, val);
             break;
         case VAR_ARRAY:
-            SvREFCNT_dec(GvAV(glob));
-            GvAV(glob) = (AV*)val;
-            GvIMPORTED_AV_on(glob);
+            GvSetAV(glob, val);
             break;
         case VAR_HASH:
-            SvREFCNT_dec(GvHV(glob));
-            GvHV(glob) = (HV*)val;
-            GvIMPORTED_HV_on(glob);
+            GvSetHV(glob, val);
             break;
         case VAR_CODE:
-            SvREFCNT_dec(GvCV(glob));
-            GvCV(glob) = (CV*)val;
-            GvIMPORTED_CV_on(glob);
-            GvASSUMECV_on(glob);
-            GvCVGEN(glob) = 0;
-            mro_method_changed_in(GvSTASH(glob));
+            GvSetCV(glob, val);
             break;
         case VAR_IO:
-            SvREFCNT_dec(GvIO(glob));
-            GvIOp(glob) = (IO*)val;
+            GvSetIO(glob, val);
             break;
         }
     }
@@ -477,19 +509,19 @@ has_symbol(self, variable)
         GV *glob = (GV*)(*entry);
         switch (variable.type) {
         case VAR_SCALAR:
-            RETVAL = GvSV(glob) ? 1 : 0;
+            RETVAL = GvSVOK(glob) ? 1 : 0;
             break;
         case VAR_ARRAY:
-            RETVAL = GvAV(glob) ? 1 : 0;
+            RETVAL = GvAVOK(glob) ? 1 : 0;
             break;
         case VAR_HASH:
-            RETVAL = GvHV(glob) ? 1 : 0;
+            RETVAL = GvHVOK(glob) ? 1 : 0;
             break;
         case VAR_CODE:
-            RETVAL = GvCV(glob) ? 1 : 0;
+            RETVAL = GvCVOK(glob) ? 1 : 0;
             break;
         case VAR_IO:
-            RETVAL = GvIO(glob) ? 1 : 0;
+            RETVAL = GvIOOK(glob) ? 1 : 0;
             break;
         }
     }
@@ -544,21 +576,19 @@ remove_symbol(self, variable)
         GV *glob = (GV*)(*entry);
         switch (variable.type) {
         case VAR_SCALAR:
-            GvSV(glob) = (SV *)NULL;
+            GvSetSV(glob, NULL);
             break;
         case VAR_ARRAY:
-            GvAV(glob) = (AV *)NULL;
+            GvSetAV(glob, NULL);
             break;
         case VAR_HASH:
-            GvHV(glob) = (HV *)NULL;
+            GvSetHV(glob, NULL);
             break;
         case VAR_CODE:
-            GvCV(glob) = (CV *)NULL;
-            GvCVGEN(glob) = 0;
-            mro_method_changed_in(GvSTASH(glob));
+            GvSetCV(glob, NULL);
             break;
         case VAR_IO:
-            GvIOp(glob) = (IO *)NULL;
+            GvSetIO(glob, NULL);
             break;
         }
     }
@@ -598,23 +628,23 @@ list_all_symbols(self, vartype=VAR_NONE)
             if (isGV(gv)) {
                 switch (vartype) {
                 case VAR_SCALAR:
-                    if (GvSV(val))
+                    if (GvSVOK(val))
                         mXPUSHp(key, len);
                     break;
                 case VAR_ARRAY:
-                    if (GvAV(val))
+                    if (GvAVOK(val))
                         mXPUSHp(key, len);
                     break;
                 case VAR_HASH:
-                    if (GvHV(val))
+                    if (GvHVOK(val))
                         mXPUSHp(key, len);
                     break;
                 case VAR_CODE:
-                    if (GvCVu(val))
+                    if (GvCVOK(val))
                         mXPUSHp(key, len);
                     break;
                 case VAR_IO:
-                    if (GvIO(val))
+                    if (GvIOOK(val))
                         mXPUSHp(key, len);
                     break;
                 }

diff --git a/t/01-basic.t b/t/01-basic.t
index 2188e07..4c4a7c9 100644 (file)
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -344,11 +344,13 @@ like(exception {
         [qw(BEGIN bar baz foo quuuux quuux quux)],
         "list_all_symbols",
     );
+    { local $TODO = $] < 5.010 ? "undef scalars aren't visible on 5.8" : undef;
     is_deeply(
         [sort $quuux->list_all_symbols('SCALAR')],
         [qw(foo)],
         "list_all_symbols SCALAR",
     );
+    }
     is_deeply(
         [sort $quuux->list_all_symbols('ARRAY')],
         [qw(bar foo)],

diff --git a/t/07-edge-cases.t b/t/07-edge-cases.t
index 75df7ac..2710c5c 100755 (executable)
--- a/t/07-edge-cases.t
+++ b/t/07-edge-cases.t
@@ -24,7 +24,9 @@ use Package::Stash;
 }
 
 my $stash = Package::Stash->new('Foo');
+{ local $TODO = $] < 5.010 ? "undef scalars aren't visible on 5.8" : undef;
 ok($stash->has_symbol('$SCALAR'), '$SCALAR');
+}
 ok($stash->has_symbol('$SCALAR_WITH_VALUE'), '$SCALAR_WITH_VALUE');
 ok($stash->has_symbol('@ARRAY'), '@ARRAY');
 ok($stash->has_symbol('%HASH'), '%HASH');