diff options
author | Jesse Luehrs <doy@tozt.net> | 2010-11-14 13:25:57 -0600 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2010-11-14 13:25:57 -0600 |
commit | d2b55565cb3bbafd9923c9b67e021bcf09c7eaa7 (patch) | |
tree | b8428b6303336e52a90eae5a5cfcea27df9afc5d | |
parent | 60b395a1c2f7efdba256d7886ad86a0a9fb87e9d (diff) | |
download | package-stash-xs-d2b55565cb3bbafd9923c9b67e021bcf09c7eaa7.tar.gz package-stash-xs-d2b55565cb3bbafd9923c9b67e021bcf09c7eaa7.zip |
implement get_all_symbols
-rw-r--r-- | Stash.xs | 49 | ||||
-rw-r--r-- | t/01-basic.t | 46 | ||||
-rw-r--r-- | t/20-leaks.t | 16 |
3 files changed, 111 insertions, 0 deletions
@@ -703,6 +703,55 @@ list_all_symbols(self, vartype=VAR_NONE) } } +void +get_all_symbols(self, vartype=VAR_NONE) + SV *self + vartype_t vartype + PREINIT: + HV *namespace, *ret; + SV *val; + char *key; + I32 len; + PPCODE: + namespace = _get_namespace(self); + ret = newHV(); + + hv_iterinit(namespace); + while ((val = hv_iternextsv(namespace, &key, &len))) { + GV *gv = (GV*)val; + + if (!isGV(gv)) + _expand_glob(self, key); + + switch (vartype) { + case VAR_SCALAR: + if (GvSVOK(val)) + hv_store(ret, key, len, newRV_inc(GvSV(gv)), 0); + break; + case VAR_ARRAY: + if (GvAVOK(val)) + hv_store(ret, key, len, newRV_inc((SV*)GvAV(gv)), 0); + break; + case VAR_HASH: + if (GvHVOK(val)) + hv_store(ret, key, len, newRV_inc((SV*)GvHV(gv)), 0); + break; + case VAR_CODE: + if (GvCVOK(val)) + hv_store(ret, key, len, newRV_inc((SV*)GvCV(gv)), 0); + break; + case VAR_IO: + if (GvIOOK(val)) + hv_store(ret, key, len, newRV_inc((SV*)GvIO(gv)), 0); + break; + case VAR_NONE: + hv_store(ret, key, len, SvREFCNT_inc_simple_NN(val), 0); + break; + } + } + + mPUSHs(newRV_noinc((SV*)ret)); + BOOT: { name_key = newSVpvs("name"); diff --git a/t/01-basic.t b/t/01-basic.t index 4c4a7c9..6b85515 100644 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -226,6 +226,52 @@ is($foo_stash->get_symbol('@foo'), $ARRAY, '... got the right values for @Foo::f ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); } +{ + my $syms = $foo_stash->get_all_symbols; + is_deeply( + [ sort keys %{ $syms } ], + [ sort $foo_stash->list_all_symbols ], + '... the fetched symbols are the same as the listed ones' + ); +} + +{ + my $syms = $foo_stash->get_all_symbols('CODE'); + + is_deeply( + [ sort keys %{ $syms } ], + [ sort $foo_stash->list_all_symbols('CODE') ], + '... the fetched symbols are the same as the listed ones' + ); + + foreach my $symbol (keys %{ $syms }) { + is($syms->{$symbol}, $foo_stash->get_symbol('&' . $symbol), '... got the right symbol'); + } +} + +{ + $foo_stash->add_symbol('%zork'); + + my $syms = $foo_stash->get_all_symbols('HASH'); + + is_deeply( + [ sort keys %{ $syms } ], + [ sort $foo_stash->list_all_symbols('HASH') ], + '... the fetched symbols are the same as the listed ones' + ); + + foreach my $symbol (keys %{ $syms }) { + is($syms->{$symbol}, $foo_stash->get_symbol('%' . $symbol), '... got the right symbol'); + } + + no warnings 'once'; + is_deeply( + $syms, + { zork => \%Foo::zork }, + "got the right ones", + ); +} + # check some errors like(exception { diff --git a/t/20-leaks.t b/t/20-leaks.t index 3954b15..d5dae8a 100644 --- a/t/20-leaks.t +++ b/t/20-leaks.t @@ -143,6 +143,22 @@ use Symbol; } "list_all_symbols doesn't leak"; } +{ + package Blah; + use constant 'baz'; +} + +{ + my $foo = Package::Stash->new('Foo'); + my $blah = Package::Stash->new('Blah'); + no_leaks_ok { + $foo->get_all_symbols; + $foo->get_all_symbols('SCALAR'); + $foo->get_all_symbols('CODE'); + $blah->get_all_symbols('CODE'); + } "list_all_symbols doesn't leak"; +} + # mimic CMOP::create_anon_class { local $TODO = $] < 5.010 ? "deleting stashes is inherently leaky on 5.8" |