diff options
| -rw-r--r-- | lib/Package/Stash.pm | 15 | ||||
| -rwxr-xr-x | t/07-edge-cases.t | 35 |
2 files changed, 40 insertions, 10 deletions
diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm index 6c361c1..88f921e 100644 --- a/lib/Package/Stash.pm +++ b/lib/Package/Stash.pm @@ -204,12 +204,7 @@ sub has_package_symbol { my $entry_ref = \$namespace->{$name}; if (reftype($entry_ref) eq 'GLOB') { - if ( $type eq 'SCALAR' ) { - return defined ${ *{$entry_ref}{SCALAR} }; - } - else { - return defined *{$entry_ref}{$type}; - } + return defined *{$entry_ref}{$type}; } else { # a symbol table entry can be -1 (stub), string (stub with prototype), @@ -392,10 +387,10 @@ sub list_all_package_symbols { # type (SCALAR|ARRAY|HASH|CODE) if ($type_filter eq 'CODE') { return grep { - (ref($namespace->{$_}) - ? (ref($namespace->{$_}) eq 'SCALAR') - : (ref(\$namespace->{$_}) eq 'GLOB' - && defined(*{$namespace->{$_}}{CODE}))); + # 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}); } keys %{$namespace}; } else { return grep { *{$namespace->{$_}}{$type_filter} } keys %{$namespace}; diff --git a/t/07-edge-cases.t b/t/07-edge-cases.t new file mode 100755 index 0000000..85944d5 --- /dev/null +++ b/t/07-edge-cases.t @@ -0,0 +1,35 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Package::Stash; + +{ + package Foo; + use constant FOO => 1; + use constant BAR => \1; + use constant BAZ => []; + use constant QUUX => {}; + use constant QUUUX => sub { }; + sub normal { } + sub stub; + sub normal_with_proto () { } + sub stub_with_proto (); + + our $SCALAR; + our @ARRAY; + our %HASH; +} + +my $stash = Package::Stash->new('Foo'); +ok($stash->has_package_symbol('$SCALAR'), '$SCALAR'); +ok($stash->has_package_symbol('@ARRAY'), '@ARRAY'); +ok($stash->has_package_symbol('%HASH'), '%HASH'); +is_deeply( + [sort $stash->list_all_package_symbols('CODE')], + [qw(BAR BAZ FOO QUUUX QUUX normal normal_with_proto stub stub_with_proto)], + "can see all code symbols" +); + +done_testing; |