implement get_all_symbols

3 files changed, 111 insertions, 0 deletions

diff --git a/Stash.xs b/Stash.xs
index 41d9c0c..b0fe7c3 100644
--- a/Stash.xs
+++ b/Stash.xs
@@ -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"