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');
62 { local $TODO = $Package::Stash::IMPLEMENTATION eq 'PP'
63 ? "the pure perl implementation leaks here somehow"
66 $foo->add_symbol('$scalar_init' => 1);
67 $foo->add_symbol('@array_init' => []);
68 $foo->add_symbol('%hash_init' => {});
69 $foo->add_symbol('&code_init' => sub { "foo" });
70 $foo->add_symbol('io_init' => Symbol::geniosym);
71 } "add_symbol doesn't leak";
74 is(Foo->code_init, 'foo', "sub installed correctly")
75 }, undef, "code_init exists");
79 my $foo = Package::Stash->new('Foo');
81 $foo->remove_symbol('$scalar_init');
82 $foo->remove_symbol('@array_init');
83 $foo->remove_symbol('%hash_init');
84 $foo->remove_symbol('&code_init');
85 $foo->remove_symbol('io_init');
86 } "remove_symbol doesn't leak";
90 my $foo = Package::Stash->new('Foo');
91 $foo->add_symbol("${_}glob") for ('$', '@', '%', '&', '');
93 $foo->remove_glob('glob');
94 } "remove_glob doesn't leak";
98 my $foo = Package::Stash->new('Foo');
100 $foo->has_symbol('io');
101 $foo->has_symbol('%hash');
102 $foo->has_symbol('@array_init');
103 $foo->has_symbol('$glob');
104 $foo->has_symbol('&something_else');
105 } "has_symbol doesn't leak";
109 my $foo = Package::Stash->new('Foo');
111 $foo->get_symbol('io');
112 $foo->get_symbol('%hash');
113 $foo->get_symbol('@array_init');
114 $foo->get_symbol('$glob');
115 $foo->get_symbol('&something_else');
116 } "get_symbol doesn't leak";
120 my $foo = Package::Stash->new('Foo');
121 ok(!$foo->has_symbol('$glob'));
122 ok(!$foo->has_symbol('@array_init'));
124 $foo->get_or_add_symbol('io');
125 $foo->get_or_add_symbol('%hash');
126 my @super = ('Exporter');
127 @{$foo->get_or_add_symbol('@ISA')} = @super;
128 $foo->get_or_add_symbol('$glob');
129 } "get_or_add_symbol doesn't leak";
130 { local $TODO = ($] < 5.010 || $Package::Stash::IMPLEMENTATION eq 'PP')
131 ? "undef scalars aren't visible on 5.8, or from pure perl at all"
133 ok($foo->has_symbol('$glob'));
135 is(ref($foo->get_symbol('$glob')), 'SCALAR');
136 ok($foo->has_symbol('@ISA'));
137 is(ref($foo->get_symbol('@ISA')), 'ARRAY');
138 is_deeply($foo->get_symbol('@ISA'), ['Exporter']);
139 isa_ok('Foo', 'Exporter');
143 my $foo = Package::Stash->new('Foo');
144 my $baz = Package::Stash->new('Baz');
146 $foo->list_all_symbols;
147 $foo->list_all_symbols('SCALAR');
148 $foo->list_all_symbols('CODE');
149 $baz->list_all_symbols('CODE');
150 } "list_all_symbols doesn't leak";
159 my $foo = Package::Stash->new('Foo');
160 my $blah = Package::Stash->new('Blah');
162 $foo->get_all_symbols;
163 $foo->get_all_symbols('SCALAR');
164 $foo->get_all_symbols('CODE');
165 $blah->get_all_symbols('CODE');
166 } "get_all_symbols doesn't leak";
169 # mimic CMOP::create_anon_class
171 local $TODO = $] < 5.010 ? "deleting stashes is inherently leaky on 5.8"
176 eval "package Quux$i; 1;";
177 my $quux = Package::Stash->new("Quux$i");
178 $quux->get_or_add_symbol('@ISA');
179 delete $::{'Quux' . $i . '::'};
180 } "get_symbol doesn't leak during glob expansion";
184 local $TODO = ($Package::Stash::IMPLEMENTATION eq 'PP'
185 && $Carp::VERSION ge '1.17')
186 ? "Carp is leaky on 5.12.2 apparently?"
188 my $foo = Package::Stash->new('Foo');
190 eval { $foo->get_or_add_symbol('&blorg') };
191 } "doesn't leak on errors";