1use strict; 2use warnings; 3use lib 't/lib'; 4use Test::More; 5use Test::Fatal; 6 7use Package::Stash; 8 9{ 10 package Foo; 11 use constant FOO => 1; 12 use constant BAR => \1; 13 use constant BAZ => []; 14 use constant QUUX => {}; 15 use constant QUUUX => sub { }; 16 sub normal { } 17 sub stub; 18 sub normal_with_proto () { } 19 sub stub_with_proto (); 20 21 our $SCALAR; 22 our $SCALAR_WITH_VALUE = 1; 23 our @ARRAY; 24 our %HASH; 25} 26 27my $stash = Package::Stash->new('Foo'); 28{ local $TODO = $] < 5.010 29 ? "undef scalars aren't visible on 5.8" 30 : undef; 31ok($stash->has_symbol('$SCALAR'), '$SCALAR'); 32} 33ok($stash->has_symbol('$SCALAR_WITH_VALUE'), '$SCALAR_WITH_VALUE'); 34ok($stash->has_symbol('@ARRAY'), '@ARRAY'); 35ok($stash->has_symbol('%HASH'), '%HASH'); 36is_deeply( 37 [sort $stash->list_all_symbols('CODE')], 38 [qw(BAR BAZ FOO QUUUX QUUX normal normal_with_proto stub stub_with_proto)], 39 "can see all code symbols" 40); 41 42$stash->add_symbol('%added', {}); 43ok(!$stash->has_symbol('$added'), '$added'); 44ok(!$stash->has_symbol('@added'), '@added'); 45ok($stash->has_symbol('%added'), '%added'); 46 47my $constant = $stash->get_symbol('&FOO'); 48is(ref($constant), 'CODE', "expanded a constant into a coderef"); 49 50# ensure get doesn't prevent subsequent vivification (not sure what the deal 51# was here) 52is(ref($stash->get_symbol('$glob')), '', "nothing yet"); 53is(ref($stash->get_or_add_symbol('$glob')), 'SCALAR', "got an empty scalar"); 54 55SKIP: { 56 skip "PP doesn't support anon stashes before 5.14", 4 57 if $] < 5.014 && $Package::Stash::IMPLEMENTATION eq 'PP'; 58 skip "XS doesn't support anon stashes before 5.10", 4 59 if $] < 5.010 && $Package::Stash::IMPLEMENTATION eq 'XS'; 60 local $TODO = "don't know how to properly inflate a stash entry in PP" 61 if $Package::Stash::IMPLEMENTATION eq 'PP'; 62 63 my $anon = {}; # not using Package::Anon 64 $anon->{foo} = -1; # stub 65 $anon->{bar} = '$&'; # stub with prototype 66 $anon->{baz} = \"foo"; # constant 67 68 my $stash = Package::Stash->new($anon); 69 is( 70 exception { 71 is(ref($stash->get_symbol('&foo')), 'CODE', 72 "stub expanded into a glob"); 73 is(ref($stash->get_symbol('&bar')), 'CODE', 74 "stub with prototype expanded into a glob"); 75 is(ref($stash->get_symbol('&baz')), 'CODE', 76 "constant expanded into a glob"); 77 }, 78 undef, 79 "can call get_symbol on weird stash entries" 80 ); 81} 82 83{ 84 my $warning; 85 local $SIG{__WARN__} = sub { $warning = $_[0] }; 86 my $stash = Package::Stash->new('Bar'); 87 $stash->add_symbol('&foo' => sub { }); 88 $stash->add_symbol('&foo' => sub { }); 89 is($warning, undef, "no redefinition warnings"); 90} 91 92{ 93 local $TODO = $] < 5.010 94 ? "undef scalars aren't visible on 5.8" 95 : undef; 96 my $stash = Package::Stash->new('Baz'); 97 $stash->add_symbol('$baz', \undef); 98 ok($stash->has_symbol('$baz'), "immortal scalars are also visible"); 99} 100 101{ 102 { 103 package HasISA::Super; 104 package HasISA; 105 our @ISA = ('HasISA::Super'); 106 } 107 ok(HasISA->isa('HasISA::Super')); 108 my $stash = Package::Stash->new('HasISA'); 109 is_deeply([$stash->list_all_symbols('SCALAR')], []); 110} 111 112done_testing; 113