From: Jesse Luehrs Date: Fri, 12 Nov 2010 09:20:16 +0000 (-0600) Subject: fix list_all_package_symbols X-Git-Tag: 0.14~66 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d1f721b320d72e83c0cb24c45fe9995a6dcf29c2;p=gitmo%2FPackage-Stash-XS.git fix list_all_package_symbols --- diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm index 132f687..4f1db68 100644 --- a/lib/Package/Stash.pm +++ b/lib/Package/Stash.pm @@ -381,7 +381,9 @@ sub remove_package_symbol { Returns a list of package variable names in the package, without sigils. If a C is passed, it is used to select package variables of a given type, where valid types are the slots of a typeglob ('SCALAR', 'CODE', 'HASH', -etc). +etc). Note that if the package contained any C blocks, perl will leave +an empty typeglob in the C slot, so this will show up if no filter is +used (and similarly for C, C, etc). =cut @@ -399,10 +401,20 @@ sub list_all_package_symbols { # any non-typeglob in the symbol table is a constant or stub ref(\$namespace->{$_}) ne 'GLOB' # regular subs are stored in the CODE slot of the typeglob - || defined(*{$namespace->{$_}}{CODE}); + || defined(*{$namespace->{$_}}{CODE}) + } keys %{$namespace}; + } + elsif ($type_filter eq 'SCALAR') { + return grep { + ref(\$namespace->{$_}) eq 'GLOB' + && defined(${*{$namespace->{$_}}{'SCALAR'}}) + } keys %{$namespace}; + } + else { + return grep { + ref(\$namespace->{$_}) eq 'GLOB' + && defined(*{$namespace->{$_}}{$type_filter}) } keys %{$namespace}; - } else { - return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace}; } } diff --git a/t/01-basic.t b/t/01-basic.t index 9c48845..4d78764 100644 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -324,4 +324,45 @@ ok(exception { } } +{ + package Quuux; + our $foo = 1; + our @foo; + our @bar; + our %baz; + sub baz { } + use constant quux => 1; + use constant quuux => []; + sub quuuux; +} + +{ + my $quuux = Package::Stash->new('Quuux'); + is_deeply( + [sort $quuux->list_all_package_symbols], + [qw(BEGIN bar baz foo quuuux quuux quux)], + "list_all_package_symbols", + ); + is_deeply( + [sort $quuux->list_all_package_symbols('SCALAR')], + [qw(foo)], + "list_all_package_symbols SCALAR", + ); + is_deeply( + [sort $quuux->list_all_package_symbols('ARRAY')], + [qw(bar foo)], + "list_all_package_symbols ARRAY", + ); + is_deeply( + [sort $quuux->list_all_package_symbols('HASH')], + [qw(baz)], + "list_all_package_symbols HASH", + ); + is_deeply( + [sort $quuux->list_all_package_symbols('CODE')], + [qw(baz quuuux quuux quux)], + "list_all_package_symbols CODE", + ); +} + done_testing;