summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2010-11-13 21:23:18 -0600
committerJesse Luehrs <doy@tozt.net>2010-11-13 21:23:18 -0600
commitd551a208f521a8e93c52f93977d6246d85b91de1 (patch)
treeb44d81148f49c928f5581e755a9f285fd56f2ed1
parent13f8a7b7b39875f66ff01549bc0e16dbba4db144 (diff)
downloadpackage-stash-xs-d551a208f521a8e93c52f93977d6246d85b91de1.tar.gz
package-stash-xs-d551a208f521a8e93c52f93977d6246d85b91de1.zip
clean up glob manipulation code, and hack around a 5.8 issue
-rw-r--r--Stash.xs114
-rw-r--r--t/01-basic.t2
-rwxr-xr-xt/07-edge-cases.t2
3 files changed, 76 insertions, 42 deletions
diff --git a/Stash.xs b/Stash.xs
index c2a4229..0ff9d32 100644
--- 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
--- 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
--- 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');