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