6 use Test::Requires 'Test::LeakTrace';
8 BEGIN { $^P |= 0x210 } # PERLDBf_SUBLINE
21 use constant baz => 1;
22 our %quux = (a => 'b');
27 Package::Stash->new('Foo');
28 } "object construction doesn't leak";
33 Package::Stash->new('Bar');
34 } "object construction doesn't leak, with an existing package";
39 Package::Stash->new('Baz');
40 } "object construction doesn't leak, with an existing package with things in it";
44 my $foo = Package::Stash->new('Foo');
48 } "accessors don't leak";
52 my $foo = Package::Stash->new('Foo');
54 $foo->add_symbol('$scalar');
55 $foo->add_symbol('@array');
56 $foo->add_symbol('%hash');
57 $foo->add_symbol('io');
58 } "add_symbol doesn't leak";
62 my $foo = Package::Stash->new('Foo');
64 $foo->add_symbol('$scalar_init' => 1);
65 $foo->add_symbol('@array_init' => []);
66 $foo->add_symbol('%hash_init' => {});
67 $foo->add_symbol('&code_init' => sub { "foo" });
68 $foo->add_symbol('io_init' => Symbol::geniosym);
69 } "add_symbol doesn't leak";
71 is(Foo->code_init, 'foo', "sub installed correctly")
72 }, undef, "code_init exists");
76 my $foo = Package::Stash->new('Foo');
78 $foo->remove_symbol('$scalar_init');
79 $foo->remove_symbol('@array_init');
80 $foo->remove_symbol('%hash_init');
81 $foo->remove_symbol('&code_init');
82 $foo->remove_symbol('io_init');
83 } "remove_symbol doesn't leak";
87 my $foo = Package::Stash->new('Foo');
88 $foo->add_symbol("${_}glob") for ('$', '@', '%', '&', '');
90 $foo->remove_glob('glob');
91 } "remove_glob doesn't leak";
95 my $foo = Package::Stash->new('Foo');
97 $foo->has_symbol('io');
98 $foo->has_symbol('%hash');
99 $foo->has_symbol('@array_init');
100 $foo->has_symbol('$glob');
101 $foo->has_symbol('&something_else');
102 } "has_symbol doesn't leak";
106 my $foo = Package::Stash->new('Foo');
108 $foo->get_symbol('io');
109 $foo->get_symbol('%hash');
110 $foo->get_symbol('@array_init');
111 $foo->get_symbol('$glob');
112 $foo->get_symbol('&something_else');
113 } "get_symbol doesn't leak";
117 my $foo = Package::Stash->new('Foo');
118 ok(!$foo->has_symbol('$glob'));
119 ok(!$foo->has_symbol('@array_init'));
121 $foo->get_or_add_symbol('io');
122 $foo->get_or_add_symbol('%hash');
123 my @super = ('Exporter');
124 @{$foo->get_or_add_symbol('@ISA')} = @super;
125 $foo->get_or_add_symbol('$glob');
126 } "get_or_add_symbol doesn't leak";
127 { local $TODO = $] < 5.010 ? "undef scalars aren't visible on 5.8" : undef;
128 ok($foo->has_symbol('$glob'));
130 is(ref($foo->get_symbol('$glob')), 'SCALAR');
131 ok($foo->has_symbol('@ISA'));
132 is(ref($foo->get_symbol('@ISA')), 'ARRAY');
133 is_deeply($foo->get_symbol('@ISA'), ['Exporter']);
134 isa_ok('Foo', 'Exporter');
138 my $foo = Package::Stash->new('Foo');
139 my $baz = Package::Stash->new('Baz');
141 $foo->list_all_symbols;
142 $foo->list_all_symbols('SCALAR');
143 $foo->list_all_symbols('CODE');
144 $baz->list_all_symbols('CODE');
145 } "list_all_symbols doesn't leak";
154 my $foo = Package::Stash->new('Foo');
155 my $blah = Package::Stash->new('Blah');
157 $foo->get_all_symbols;
158 $foo->get_all_symbols('SCALAR');
159 $foo->get_all_symbols('CODE');
160 $blah->get_all_symbols('CODE');
161 } "list_all_symbols doesn't leak";
164 # mimic CMOP::create_anon_class
166 local $TODO = $] < 5.010 ? "deleting stashes is inherently leaky on 5.8"
171 eval "package Quux$i; 1;";
172 my $quux = Package::Stash->new("Quux$i");
173 $quux->get_or_add_symbol('@ISA');
174 delete $::{'Quux' . $i . '::'};
175 } "get_symbol doesn't leak during glob expansion";
179 my $foo = Package::Stash->new('Foo');
181 eval { $foo->get_or_add_symbol('&blorg') };
182 } "doesn't leak on errors";