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