20 use constant baz => 1;
21 our %quux = (a => 'b');
26 Package::Stash->new('Foo');
27 } "object construction doesn't leak";
32 Package::Stash->new('Bar');
33 } "object construction doesn't leak, with an existing package";
38 Package::Stash->new('Baz');
39 } "object construction doesn't leak, with an existing package with things in it";
43 my $foo = Package::Stash->new('Foo');
47 } "accessors don't leak";
51 my $foo = Package::Stash->new('Foo');
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";
61 my $foo = Package::Stash->new('Foo');
63 $foo->add_symbol('$scalar_init' => 1);
64 } "add_symbol scalar doesn't leak";
66 $foo->add_symbol('@array_init' => []);
67 } "add_symbol array doesn't leak";
69 $foo->add_symbol('%hash_init' => {});
70 } "add_symbol hash doesn't leak";
72 $foo->add_symbol('&code_init' => sub { "foo" });
73 } "add_symbol code doesn't leak";
74 { local $TODO = $Package::Stash::IMPLEMENTATION eq 'PP'
75 ? "the pure perl implementation leaks here somehow"
78 $foo->add_symbol('io_init' => Symbol::geniosym);
79 } "add_symbol io doesn't leak";
82 is(Foo->code_init, 'foo', "sub installed correctly")
83 }, undef, "code_init exists");
87 my $foo = Package::Stash->new('Foo');
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";
98 my $foo = Package::Stash->new('Foo');
99 $foo->add_symbol("${_}glob") for ('$', '@', '%', '&', '');
101 $foo->remove_glob('glob');
102 } "remove_glob doesn't leak";
106 my $foo = Package::Stash->new('Foo');
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";
117 my $foo = Package::Stash->new('Foo');
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";
128 my $foo = Package::Stash->new('Foo');
129 ok(!$foo->has_symbol('$glob'));
130 ok(!$foo->has_symbol('@array_init'));
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";
138 { local $TODO = $] < 5.010
139 ? "undef scalars aren't visible on 5.8"
141 ok($foo->has_symbol('$glob'));
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');
151 my $foo = Package::Stash->new('Foo');
152 my $baz = Package::Stash->new('Baz');
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";
167 my $foo = Package::Stash->new('Foo');
168 my $blah = Package::Stash->new('Blah');
170 $foo->get_all_symbols;
171 $foo->get_all_symbols('SCALAR');
172 $foo->get_all_symbols('CODE');
173 $blah->get_all_symbols('CODE');
174 } "get_all_symbols doesn't leak";
177 # mimic CMOP::create_anon_class
179 local $TODO = $] < 5.010 ? "deleting stashes is inherently leaky on 5.8"
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";
192 local $TODO = ($Package::Stash::IMPLEMENTATION eq 'PP'
193 && $Carp::VERSION ge '1.17')
194 ? "Carp is leaky on 5.12.2 apparently?"
196 my $foo = Package::Stash->new('Foo');
198 eval { $foo->get_or_add_symbol('&blorg') };
199 } "doesn't leak on errors";