summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-11-29 14:07:30 -0600
committerJesse Luehrs <doy@tozt.net>2011-11-29 14:25:52 -0600
commite88665a5772fd94a541366c984ecbade0b39fc95 (patch)
tree9c70a189d8adaa084855c6052963658ab648857d
parentbc2b0715c4ea2aa257cd3cf2f1b8c3fe3559cf47 (diff)
downloadpackage-stash-e88665a5772fd94a541366c984ecbade0b39fc95.tar.gz
package-stash-e88665a5772fd94a541366c984ecbade0b39fc95.zip
better diagnostics for get_symbol issues on bare anon stashes
-rw-r--r--lib/Package/Stash/PP.pm24
-rwxr-xr-xt/edge-cases.t26
2 files changed, 43 insertions, 7 deletions
diff --git a/lib/Package/Stash/PP.pm b/lib/Package/Stash/PP.pm
index 4996c39..8d95840 100644
--- a/lib/Package/Stash/PP.pm
+++ b/lib/Package/Stash/PP.pm
@@ -88,6 +88,10 @@ sub namespace {
}
}
+sub _is_anon {
+ return !defined $_[0]->{package};
+}
+
{
my %SIGIL_MAP = (
'$' => 'SCALAR',
@@ -270,19 +274,25 @@ sub get_symbol {
}
else {
if ($type eq 'CODE') {
+ if (BROKEN_GLOB_ASSIGNMENT || !$self->_is_anon) {
+ no strict 'refs';
+ return \&{ $self->name . '::' . $name };
+ }
+
# XXX we should really be able to support arbitrary anonymous
# stashes here... (not just via Package::Anon)
- if (!BROKEN_GLOB_ASSIGNMENT
- && blessed($namespace)
- && $namespace->isa('Package::Anon')) {
- # ->can will call gv_init for us
+ if (blessed($namespace) && $namespace->isa('Package::Anon')) {
+ # ->can will call gv_init for us, which inflates the glob
+ # don't know how to do this in general
$namespace->bless(\(my $foo))->can($name);
- return *{ $namespace->{$name} }{CODE};
}
else {
- no strict 'refs';
- return \&{ $self->name . '::' . $name };
+ confess "Don't know how to inflate a " . ref($entry_ref)
+ . " into a full coderef (perhaps you could use"
+ . " Package::Anon instead of a bare stash?)"
}
+
+ return *{ $namespace->{$name} }{CODE};
}
else {
return undef;
diff --git a/t/edge-cases.t b/t/edge-cases.t
index 04e2164..b1e5bb8 100755
--- a/t/edge-cases.t
+++ b/t/edge-cases.t
@@ -53,4 +53,30 @@ is(ref($constant), 'CODE', "expanded a constant into a coderef");
is(ref($stash->get_symbol('$glob')), '', "nothing yet");
is(ref($stash->get_or_add_symbol('$glob')), 'SCALAR', "got an empty scalar");
+SKIP: {
+ skip "PP doesn't support anon stashes before 5.14", 4
+ if $Package::Stash::IMPLEMENTATION eq 'PP'
+ && Package::Stash::BROKEN_GLOB_ASSIGNMENT;
+ local $TODO = "don't know how to properly inflate a stash entry";
+
+ my $anon = {}; # not using Package::Anon
+ $anon->{foo} = -1; # stub
+ $anon->{bar} = '$&'; # stub with prototype
+ $anon->{baz} = \"foo"; # constant
+
+ my $stash = Package::Stash->new($anon);
+ is(
+ exception {
+ is(ref($stash->get_symbol('&foo')), 'CODE',
+ "stub expanded into a glob");
+ is(ref($stash->get_symbol('&bar')), 'CODE',
+ "stub with prototype expanded into a glob");
+ is(ref($stash->get_symbol('&baz')), 'CODE',
+ "constant expanded into a glob");
+ },
+ undef,
+ "can call get_symbol on weird stash entries"
+ );
+}
+
done_testing;