1use strict;
2use warnings;
3use lib 't/lib';
4use Test::More;
5
6use Package::Stash;
7
8# @ISA magic
9{
10    my $Foo = Package::Stash->new('ISAFoo');
11    $Foo->add_symbol('&foo' => sub { });
12
13    my $Bar = Package::Stash->new('ISABar');
14    @{ $Bar->get_or_add_symbol('@ISA') } = ('ISAFoo');
15    can_ok('ISABar', 'foo');
16
17    my $Foo2 = Package::Stash->new('ISAFoo2');
18    $Foo2->add_symbol('&foo2' => sub { });
19    @{ $Bar->get_or_add_symbol('@ISA') } = ('ISAFoo2');
20    can_ok('ISABar', 'foo2');
21    ok(!Bar->can('foo'));
22}
23
24{
25    my $main = Package::Stash->new('main');
26    $main->add_symbol('$"', '-');
27    my @foo = qw(a b c);
28    is(eval q["@foo"], 'a-b-c');
29}
30
31SKIP: {
32    skip "only need to test for magic in the xs version", 10
33        unless $Package::Stash::IMPLEMENTATION eq 'XS';
34    skip "magic stashes require perl 5.10+", 10
35        unless $] >= 5.010;
36    skip "magic stashes require Variable::Magic", 10
37        unless eval { require Variable::Magic; 1 };
38
39    my ($fetch, $store);
40    my $wiz = Variable::Magic::wizard(
41        fetch => sub { $fetch++ },
42        store => sub { $store++ },
43    );
44    Variable::Magic::cast(\%MagicStashTest::, $wiz);
45
46    my $stash = Package::Stash->new('MagicStashTest');
47
48    $fetch = 0;
49    $store = 0;
50    $stash->get_symbol('@foo');
51    is($fetch, 1, "get_symbol fetches (empty slot)");
52    is($store, 0, "get_symbol stores (empty slot)");
53
54    $fetch = 0;
55    $store = 0;
56    $stash->get_or_add_symbol('@bar');
57    is($fetch, 0, "get_or_add_symbol fetches (empty slot)");
58    is($store, 1, "get_or_add_symbol stores (empty slot)");
59
60    $fetch = 0;
61    $store = 0;
62    $stash->add_symbol('@baz', ['baz']);
63    is($fetch, 0, "add_symbol fetches");
64    is($store, 1, "add_symbol stores");
65
66    $fetch = 0;
67    $store = 0;
68    $stash->get_symbol('@baz');
69    is($fetch, 1, "get_symbol fetches (populated slot)");
70    is($store, 0, "get_symbol stores (populated slot)");
71
72    $fetch = 0;
73    $store = 0;
74    $stash->get_or_add_symbol('@baz');
75    is($fetch, 1, "get_or_add_symbol fetches (populated slot)");
76    is($store, 0, "get_or_add_symbol stores (populated slot)");
77}
78
79done_testing;
80