almost complete pure perl implementation
[gitmo/Package-Stash.git] / t / 20-leaks.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use lib 't/lib';
5 use Test::More;
6 use Test::Fatal;
7 use Test::Requires 'Test::LeakTrace';
8
9 use Package::Stash;
10 use Symbol;
11
12 {
13     package Bar;
14 }
15
16 {
17     package Baz;
18     our $foo;
19     sub bar { }
20     use constant baz => 1;
21     our %quux = (a => 'b');
22 }
23
24 {
25     no_leaks_ok {
26         Package::Stash->new('Foo');
27     } "object construction doesn't leak";
28 }
29
30 {
31     no_leaks_ok {
32         Package::Stash->new('Bar');
33     } "object construction doesn't leak, with an existing package";
34 }
35
36 {
37     no_leaks_ok {
38         Package::Stash->new('Baz');
39     } "object construction doesn't leak, with an existing package with things in it";
40 }
41
42 {
43     my $foo = Package::Stash->new('Foo');
44     no_leaks_ok {
45         $foo->name;
46         $foo->namespace;
47     } "accessors don't leak";
48 }
49
50 {
51     my $foo = Package::Stash->new('Foo');
52     no_leaks_ok {
53         $foo->add_symbol('$scalar');
54         $foo->add_symbol('@array');
55         $foo->add_symbol('%hash');
56         $foo->add_symbol('io');
57     } "add_symbol doesn't leak";
58 }
59
60 {
61     my $foo = Package::Stash->new('Foo');
62     no_leaks_ok {
63         $foo->add_symbol('$scalar_init' => 1);
64         $foo->add_symbol('@array_init' => []);
65         $foo->add_symbol('%hash_init' => {});
66         $foo->add_symbol('&code_init' => sub { "foo" });
67         $foo->add_symbol('io_init' => Symbol::geniosym);
68     } "add_symbol doesn't leak";
69     is(exception {
70         is(Foo->code_init, 'foo', "sub installed correctly")
71     }, undef, "code_init exists");
72 }
73
74 {
75     my $foo = Package::Stash->new('Foo');
76     no_leaks_ok {
77         $foo->remove_symbol('$scalar_init');
78         $foo->remove_symbol('@array_init');
79         $foo->remove_symbol('%hash_init');
80         $foo->remove_symbol('&code_init');
81         $foo->remove_symbol('io_init');
82     } "remove_symbol doesn't leak";
83 }
84
85 {
86     my $foo = Package::Stash->new('Foo');
87     $foo->add_symbol("${_}glob") for ('$', '@', '%', '&', '');
88     no_leaks_ok {
89         $foo->remove_glob('glob');
90     } "remove_glob doesn't leak";
91 }
92
93 {
94     my $foo = Package::Stash->new('Foo');
95     no_leaks_ok {
96         $foo->has_symbol('io');
97         $foo->has_symbol('%hash');
98         $foo->has_symbol('@array_init');
99         $foo->has_symbol('$glob');
100         $foo->has_symbol('&something_else');
101     } "has_symbol doesn't leak";
102 }
103
104 {
105     my $foo = Package::Stash->new('Foo');
106     no_leaks_ok {
107         $foo->get_symbol('io');
108         $foo->get_symbol('%hash');
109         $foo->get_symbol('@array_init');
110         $foo->get_symbol('$glob');
111         $foo->get_symbol('&something_else');
112     } "get_symbol doesn't leak";
113 }
114
115 {
116     my $foo = Package::Stash->new('Foo');
117     ok(!$foo->has_symbol('$glob'));
118     ok(!$foo->has_symbol('@array_init'));
119     no_leaks_ok {
120         $foo->get_or_add_symbol('io');
121         $foo->get_or_add_symbol('%hash');
122         my @super = ('Exporter');
123         @{$foo->get_or_add_symbol('@ISA')} = @super;
124         $foo->get_or_add_symbol('$glob');
125     } "get_or_add_symbol doesn't leak";
126     { local $TODO = ($] < 5.010 || $Package::Stash::IMPLEMENTATION eq 'PP')
127         ? "undef scalars aren't visible on 5.8, or from pure perl at all"
128         : undef;
129     ok($foo->has_symbol('$glob'));
130     }
131     is(ref($foo->get_symbol('$glob')), 'SCALAR');
132     ok($foo->has_symbol('@ISA'));
133     is(ref($foo->get_symbol('@ISA')), 'ARRAY');
134     is_deeply($foo->get_symbol('@ISA'), ['Exporter']);
135     isa_ok('Foo', 'Exporter');
136 }
137
138 {
139     my $foo = Package::Stash->new('Foo');
140     my $baz = Package::Stash->new('Baz');
141     no_leaks_ok {
142         $foo->list_all_symbols;
143         $foo->list_all_symbols('SCALAR');
144         $foo->list_all_symbols('CODE');
145         $baz->list_all_symbols('CODE');
146     } "list_all_symbols doesn't leak";
147 }
148
149 {
150     package Blah;
151     use constant 'baz';
152 }
153
154 {
155     my $foo = Package::Stash->new('Foo');
156     my $blah = Package::Stash->new('Blah');
157     no_leaks_ok {
158         $foo->get_all_symbols;
159         $foo->get_all_symbols('SCALAR');
160         $foo->get_all_symbols('CODE');
161         $blah->get_all_symbols('CODE');
162     } "get_all_symbols doesn't leak";
163 }
164
165 # mimic CMOP::create_anon_class
166 {
167     local $TODO = $] < 5.010 ? "deleting stashes is inherently leaky on 5.8"
168                              : undef;
169     my $i = 0;
170     no_leaks_ok {
171         $i++;
172         eval "package Quux$i; 1;";
173         my $quux = Package::Stash->new("Quux$i");
174         $quux->get_or_add_symbol('@ISA');
175         delete $::{'Quux' . $i . '::'};
176     } "get_symbol doesn't leak during glob expansion";
177 }
178
179 {
180     my $foo = Package::Stash->new('Foo');
181     no_leaks_ok {
182         eval { $foo->get_or_add_symbol('&blorg') };
183     } "doesn't leak on errors";
184 }
185
186 done_testing;