7 use Test::Requires 'Test::LeakTrace';
9 BEGIN { $^P |= 0x210 } # PERLDBf_SUBLINE
22 use constant baz => 1;
23 our %quux = (a => 'b');
28 Package::Stash->new('Foo');
29 } "object construction doesn't leak";
34 Package::Stash->new('Bar');
35 } "object construction doesn't leak, with an existing package";
40 Package::Stash->new('Baz');
41 } "object construction doesn't leak, with an existing package with things in it";
45 my $foo = Package::Stash->new('Foo');
49 } "accessors don't leak";
53 my $foo = Package::Stash->new('Foo');
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";
63 my $foo = Package::Stash->new('Foo');
65 $foo->add_symbol('$scalar_init' => 1);
66 $foo->add_symbol('@array_init' => []);
67 $foo->add_symbol('%hash_init' => {});
68 $foo->add_symbol('&code_init' => sub { "foo" });
69 $foo->add_symbol('io_init' => Symbol::geniosym);
70 } "add_symbol doesn't leak";
72 is(Foo->code_init, 'foo', "sub installed correctly")
73 }, undef, "code_init exists");
77 my $foo = Package::Stash->new('Foo');
79 $foo->remove_symbol('$scalar_init');
80 $foo->remove_symbol('@array_init');
81 $foo->remove_symbol('%hash_init');
82 $foo->remove_symbol('&code_init');
83 $foo->remove_symbol('io_init');
84 } "remove_symbol doesn't leak";
88 my $foo = Package::Stash->new('Foo');
89 $foo->add_symbol("${_}glob") for ('$', '@', '%', '&', '');
91 $foo->remove_glob('glob');
92 } "remove_glob doesn't leak";
96 my $foo = Package::Stash->new('Foo');
98 $foo->has_symbol('io');
99 $foo->has_symbol('%hash');
100 $foo->has_symbol('@array_init');
101 $foo->has_symbol('$glob');
102 $foo->has_symbol('&something_else');
103 } "has_symbol doesn't leak";
107 my $foo = Package::Stash->new('Foo');
109 $foo->get_symbol('io');
110 $foo->get_symbol('%hash');
111 $foo->get_symbol('@array_init');
112 $foo->get_symbol('$glob');
113 $foo->get_symbol('&something_else');
114 } "get_symbol doesn't leak";
118 my $foo = Package::Stash->new('Foo');
119 ok(!$foo->has_symbol('$glob'));
120 ok(!$foo->has_symbol('@array_init'));
122 $foo->get_or_add_symbol('io');
123 $foo->get_or_add_symbol('%hash');
124 my @super = ('Exporter');
125 @{$foo->get_or_add_symbol('@ISA')} = @super;
126 $foo->get_or_add_symbol('$glob');
127 } "get_or_add_symbol doesn't leak";
128 { local $TODO = ($] < 5.010 || $Package::Stash::IMPLEMENTATION eq 'PP')
129 ? "undef scalars aren't visible on 5.8, or from pure perl at all"
131 ok($foo->has_symbol('$glob'));
133 is(ref($foo->get_symbol('$glob')), 'SCALAR');
134 ok($foo->has_symbol('@ISA'));
135 is(ref($foo->get_symbol('@ISA')), 'ARRAY');
136 is_deeply($foo->get_symbol('@ISA'), ['Exporter']);
137 isa_ok('Foo', 'Exporter');
141 my $foo = Package::Stash->new('Foo');
142 my $baz = Package::Stash->new('Baz');
144 $foo->list_all_symbols;
145 $foo->list_all_symbols('SCALAR');
146 $foo->list_all_symbols('CODE');
147 $baz->list_all_symbols('CODE');
148 } "list_all_symbols doesn't leak";
157 my $foo = Package::Stash->new('Foo');
158 my $blah = Package::Stash->new('Blah');
160 $foo->get_all_symbols;
161 $foo->get_all_symbols('SCALAR');
162 $foo->get_all_symbols('CODE');
163 $blah->get_all_symbols('CODE');
164 } "get_all_symbols doesn't leak";
167 # mimic CMOP::create_anon_class
169 local $TODO = $] < 5.010 ? "deleting stashes is inherently leaky on 5.8"
174 eval "package Quux$i; 1;";
175 my $quux = Package::Stash->new("Quux$i");
176 $quux->get_or_add_symbol('@ISA');
177 delete $::{'Quux' . $i . '::'};
178 } "get_symbol doesn't leak during glob expansion";
182 my $foo = Package::Stash->new('Foo');
184 eval { $foo->get_or_add_symbol('&blorg') };
185 } "doesn't leak on errors";