Commit | Line | Data |
58710c0b |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
c53d2df2 |
4 | use lib 't/lib'; |
58710c0b |
5 | use Test::More; |
6 | use Test::Fatal; |
9048284a |
7 | use Test::LeakTrace; |
58710c0b |
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'); |
bb19eac1 |
52 | no_leaks_ok { |
15c104e2 |
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"; |
58710c0b |
58 | } |
59 | |
60 | { |
61 | my $foo = Package::Stash->new('Foo'); |
bb19eac1 |
62 | no_leaks_ok { |
15c104e2 |
63 | $foo->add_symbol('$scalar_init' => 1); |
05f9df44 |
64 | } "add_symbol scalar doesn't leak"; |
65 | no_leaks_ok { |
15c104e2 |
66 | $foo->add_symbol('@array_init' => []); |
05f9df44 |
67 | } "add_symbol array doesn't leak"; |
68 | no_leaks_ok { |
15c104e2 |
69 | $foo->add_symbol('%hash_init' => {}); |
05f9df44 |
70 | } "add_symbol hash doesn't leak"; |
71 | no_leaks_ok { |
15c104e2 |
72 | $foo->add_symbol('&code_init' => sub { "foo" }); |
05f9df44 |
73 | } "add_symbol code doesn't leak"; |
fb4f6d8a |
74 | { local $TODO = "this leaks here somehow"; |
05f9df44 |
75 | no_leaks_ok { |
15c104e2 |
76 | $foo->add_symbol('io_init' => Symbol::geniosym); |
05f9df44 |
77 | } "add_symbol io doesn't leak"; |
b08a737b |
78 | } |
58710c0b |
79 | is(exception { |
80 | is(Foo->code_init, 'foo', "sub installed correctly") |
81 | }, undef, "code_init exists"); |
82 | } |
83 | |
84 | { |
85 | my $foo = Package::Stash->new('Foo'); |
86 | no_leaks_ok { |
15c104e2 |
87 | $foo->remove_symbol('$scalar_init'); |
88 | $foo->remove_symbol('@array_init'); |
89 | $foo->remove_symbol('%hash_init'); |
90 | $foo->remove_symbol('&code_init'); |
91 | $foo->remove_symbol('io_init'); |
92 | } "remove_symbol doesn't leak"; |
58710c0b |
93 | } |
94 | |
95 | { |
96 | my $foo = Package::Stash->new('Foo'); |
15c104e2 |
97 | $foo->add_symbol("${_}glob") for ('$', '@', '%', '&', ''); |
58710c0b |
98 | no_leaks_ok { |
15c104e2 |
99 | $foo->remove_glob('glob'); |
100 | } "remove_glob doesn't leak"; |
58710c0b |
101 | } |
102 | |
103 | { |
104 | my $foo = Package::Stash->new('Foo'); |
105 | no_leaks_ok { |
15c104e2 |
106 | $foo->has_symbol('io'); |
107 | $foo->has_symbol('%hash'); |
108 | $foo->has_symbol('@array_init'); |
109 | $foo->has_symbol('$glob'); |
110 | $foo->has_symbol('&something_else'); |
111 | } "has_symbol doesn't leak"; |
58710c0b |
112 | } |
113 | |
114 | { |
115 | my $foo = Package::Stash->new('Foo'); |
116 | no_leaks_ok { |
15c104e2 |
117 | $foo->get_symbol('io'); |
118 | $foo->get_symbol('%hash'); |
119 | $foo->get_symbol('@array_init'); |
120 | $foo->get_symbol('$glob'); |
121 | $foo->get_symbol('&something_else'); |
122 | } "get_symbol doesn't leak"; |
58710c0b |
123 | } |
124 | |
125 | { |
126 | my $foo = Package::Stash->new('Foo'); |
15c104e2 |
127 | ok(!$foo->has_symbol('$glob')); |
128 | ok(!$foo->has_symbol('@array_init')); |
58710c0b |
129 | no_leaks_ok { |
15c104e2 |
130 | $foo->get_or_add_symbol('io'); |
131 | $foo->get_or_add_symbol('%hash'); |
c5e221f9 |
132 | my @super = ('Exporter'); |
15c104e2 |
133 | @{$foo->get_or_add_symbol('@ISA')} = @super; |
134 | $foo->get_or_add_symbol('$glob'); |
135 | } "get_or_add_symbol doesn't leak"; |
05f9df44 |
136 | { local $TODO = $] < 5.010 |
137 | ? "undef scalars aren't visible on 5.8" |
9e60e8ff |
138 | : undef; |
15c104e2 |
139 | ok($foo->has_symbol('$glob')); |
520f29d6 |
140 | } |
15c104e2 |
141 | is(ref($foo->get_symbol('$glob')), 'SCALAR'); |
142 | ok($foo->has_symbol('@ISA')); |
143 | is(ref($foo->get_symbol('@ISA')), 'ARRAY'); |
144 | is_deeply($foo->get_symbol('@ISA'), ['Exporter']); |
c5e221f9 |
145 | isa_ok('Foo', 'Exporter'); |
58710c0b |
146 | } |
147 | |
148 | { |
149 | my $foo = Package::Stash->new('Foo'); |
150 | my $baz = Package::Stash->new('Baz'); |
151 | no_leaks_ok { |
15c104e2 |
152 | $foo->list_all_symbols; |
153 | $foo->list_all_symbols('SCALAR'); |
154 | $foo->list_all_symbols('CODE'); |
155 | $baz->list_all_symbols('CODE'); |
156 | } "list_all_symbols doesn't leak"; |
58710c0b |
157 | } |
158 | |
d2b55565 |
159 | { |
160 | package Blah; |
161 | use constant 'baz'; |
162 | } |
163 | |
164 | { |
165 | my $foo = Package::Stash->new('Foo'); |
166 | my $blah = Package::Stash->new('Blah'); |
167 | no_leaks_ok { |
168 | $foo->get_all_symbols; |
169 | $foo->get_all_symbols('SCALAR'); |
170 | $foo->get_all_symbols('CODE'); |
171 | $blah->get_all_symbols('CODE'); |
9e60e8ff |
172 | } "get_all_symbols doesn't leak"; |
d2b55565 |
173 | } |
174 | |
02b2a57f |
175 | # mimic CMOP::create_anon_class |
176 | { |
4aa6913b |
177 | local $TODO = $] < 5.010 ? "deleting stashes is inherently leaky on 5.8" |
178 | : undef; |
02b2a57f |
179 | my $i = 0; |
180 | no_leaks_ok { |
181 | $i++; |
182 | eval "package Quux$i; 1;"; |
183 | my $quux = Package::Stash->new("Quux$i"); |
15c104e2 |
184 | $quux->get_or_add_symbol('@ISA'); |
02b2a57f |
185 | delete $::{'Quux' . $i . '::'}; |
15c104e2 |
186 | } "get_symbol doesn't leak during glob expansion"; |
02b2a57f |
187 | } |
188 | |
cc3f1e42 |
189 | { |
b08a737b |
190 | local $TODO = ($Package::Stash::IMPLEMENTATION eq 'PP' |
191 | && $Carp::VERSION ge '1.17') |
192 | ? "Carp is leaky on 5.12.2 apparently?" |
193 | : undef; |
cc3f1e42 |
194 | my $foo = Package::Stash->new('Foo'); |
195 | no_leaks_ok { |
196 | eval { $foo->get_or_add_symbol('&blorg') }; |
197 | } "doesn't leak on errors"; |
198 | } |
199 | |
58710c0b |
200 | done_testing; |