diff options
author | Jesse Luehrs <doy@tozt.net> | 2013-01-04 03:16:12 -0600 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2013-01-04 03:16:12 -0600 |
commit | 07da32a70bfd89df3c0bdeb3236c413cff86a2fa (patch) | |
tree | 7093f768a75e5d70b4de594f8202b4c2ac9e5796 | |
parent | b6a64d546b32da81d5a23e3df0ef47ffc6ed07b5 (diff) | |
download | package-stash-07da32a70bfd89df3c0bdeb3236c413cff86a2fa.tar.gz package-stash-07da32a70bfd89df3c0bdeb3236c413cff86a2fa.zip |
apparently ->isa lookups used to be cached in the package
-rw-r--r-- | lib/Package/Stash/PP.pm | 16 | ||||
-rwxr-xr-x | t/edge-cases.t | 11 |
2 files changed, 24 insertions, 3 deletions
diff --git a/lib/Package/Stash/PP.pm b/lib/Package/Stash/PP.pm index c709400..9e53d66 100644 --- a/lib/Package/Stash/PP.pm +++ b/lib/Package/Stash/PP.pm @@ -19,6 +19,8 @@ use constant BROKEN_SCALAR_INITIALIZATION => ($] < 5.010); # add_method on anon stashes triggers rt.perl #1804 otherwise # fixed in perl commit v5.13.3-70-g0fe688f use constant BROKEN_GLOB_ASSIGNMENT => ($] < 5.013004); +# pre-5.10, ->isa lookups were cached in the ::ISA::CACHE:: slot +use constant HAS_ISA_CACHE => ($] < 5.010); =head1 SYNOPSIS @@ -364,7 +366,14 @@ sub list_all_symbols { my ($self, $type_filter) = @_; my $namespace = $self->namespace; - return keys %{$namespace} unless defined $type_filter; + if (HAS_ISA_CACHE) { + return grep { $_ ne '::ISA::CACHE::' } keys %{$namespace} + unless defined $type_filter; + } + else { + return keys %{$namespace} + unless defined $type_filter; + } # NOTE: # or we can filter based on @@ -379,14 +388,15 @@ sub list_all_symbols { } elsif ($type_filter eq 'SCALAR') { return grep { - BROKEN_SCALAR_INITIALIZATION + !(HAS_ISA_CACHE && $_ eq '::ISA::CACHE::') && + (BROKEN_SCALAR_INITIALIZATION ? (ref(\$namespace->{$_}) eq 'GLOB' && defined(${*{$namespace->{$_}}{'SCALAR'}})) : (do { my $entry = \$namespace->{$_}; ref($entry) eq 'GLOB' && B::svref_2object($entry)->SV->isa('B::SV') - }) + })) } keys %{$namespace}; } else { diff --git a/t/edge-cases.t b/t/edge-cases.t index 4e851c3..58c5dc8 100755 --- a/t/edge-cases.t +++ b/t/edge-cases.t @@ -99,4 +99,15 @@ SKIP: { ok($stash->has_symbol('$baz'), "immortal scalars are also visible"); } +{ + { + package HasISA::Super; + package HasISA; + our @ISA = ('HasISA::Super'); + } + ok(HasISA->isa('HasISA::Super')); + my $stash = Package::Stash->new('HasISA'); + is_deeply([$stash->list_all_symbols('SCALAR')], []); +} + done_testing; |