diff options
Diffstat (limited to 't/edge-cases.t')
-rw-r--r-- | t/edge-cases.t | 113 |
1 files changed, 113 insertions, 0 deletions
diff --git a/t/edge-cases.t b/t/edge-cases.t new file mode 100644 index 0000000..58c5dc8 --- /dev/null +++ b/t/edge-cases.t @@ -0,0 +1,113 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use lib 't/lib'; +use Test::More; +use Test::Fatal; + +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 $SCALAR_WITH_VALUE = 1; + our @ARRAY; + our %HASH; +} + +my $stash = Package::Stash->new('Foo'); +{ local $TODO = $] < 5.010 + ? "undef scalars aren't visible on 5.8" + : undef; +ok($stash->has_symbol('$SCALAR'), '$SCALAR'); +} +ok($stash->has_symbol('$SCALAR_WITH_VALUE'), '$SCALAR_WITH_VALUE'); +ok($stash->has_symbol('@ARRAY'), '@ARRAY'); +ok($stash->has_symbol('%HASH'), '%HASH'); +is_deeply( + [sort $stash->list_all_symbols('CODE')], + [qw(BAR BAZ FOO QUUUX QUUX normal normal_with_proto stub stub_with_proto)], + "can see all code symbols" +); + +$stash->add_symbol('%added', {}); +ok(!$stash->has_symbol('$added'), '$added'); +ok(!$stash->has_symbol('@added'), '@added'); +ok($stash->has_symbol('%added'), '%added'); + +my $constant = $stash->get_symbol('&FOO'); +is(ref($constant), 'CODE', "expanded a constant into a coderef"); + +# ensure get doesn't prevent subsequent vivification (not sure what the deal +# was here) +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 $] < 5.014 && $Package::Stash::IMPLEMENTATION eq 'PP'; + skip "XS doesn't support anon stashes before 5.10", 4 + if $] < 5.010 && $Package::Stash::IMPLEMENTATION eq 'XS'; + local $TODO = "don't know how to properly inflate a stash entry in PP" + if $Package::Stash::IMPLEMENTATION eq 'PP'; + + 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" + ); +} + +{ + my $warning; + local $SIG{__WARN__} = sub { $warning = $_[0] }; + my $stash = Package::Stash->new('Bar'); + $stash->add_symbol('&foo' => sub { }); + $stash->add_symbol('&foo' => sub { }); + is($warning, undef, "no redefinition warnings"); +} + +{ + local $TODO = $] < 5.010 + ? "undef scalars aren't visible on 5.8" + : undef; + my $stash = Package::Stash->new('Baz'); + $stash->add_symbol('$baz', \undef); + 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; |