6 use Test::Requires 'Test::LeakTrace';
19 use constant baz => 1;
20 our %quux = (a => 'b');
25 Package::Stash->new('Foo');
26 } "object construction doesn't leak";
31 Package::Stash->new('Bar');
32 } "object construction doesn't leak, with an existing package";
37 Package::Stash->new('Baz');
38 } "object construction doesn't leak, with an existing package with things in it";
42 my $foo = Package::Stash->new('Foo');
46 } "accessors don't leak";
50 my $foo = Package::Stash->new('Foo');
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";
60 my $foo = Package::Stash->new('Foo');
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";
69 is(Foo->code_init, 'foo', "sub installed correctly")
70 }, undef, "code_init exists");
74 my $foo = Package::Stash->new('Foo');
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";
85 my $foo = Package::Stash->new('Foo');
86 $foo->add_symbol("${_}glob") for ('$', '@', '%', '&', '');
88 $foo->remove_glob('glob');
89 } "remove_glob doesn't leak";
93 my $foo = Package::Stash->new('Foo');
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";
104 my $foo = Package::Stash->new('Foo');
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";
115 my $foo = Package::Stash->new('Foo');
116 ok(!$foo->has_symbol('$glob'));
117 ok(!$foo->has_symbol('@array_init'));
119 $foo->get_or_add_symbol('io');
120 $foo->get_or_add_symbol('%hash');
121 my @super = ('Exporter');
122 @{$foo->get_or_add_symbol('@ISA')} = @super;
123 $foo->get_or_add_symbol('$glob');
124 } "get_or_add_symbol doesn't leak";
125 { local $TODO = $] < 5.010 ? "undef scalars aren't visible on 5.8" : undef;
126 ok($foo->has_symbol('$glob'));
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']);
132 isa_ok('Foo', 'Exporter');
136 my $foo = Package::Stash->new('Foo');
137 my $baz = Package::Stash->new('Baz');
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";
146 # mimic CMOP::create_anon_class
148 local $TODO = $] < 5.010 ? "deleting stashes is inherently leaky on 5.8"
153 eval "package Quux$i; 1;";
154 my $quux = Package::Stash->new("Quux$i");
155 $quux->get_or_add_symbol('@ISA');
156 delete $::{'Quux' . $i . '::'};
157 } "get_symbol doesn't leak during glob expansion";
161 my $foo = Package::Stash->new('Foo');
163 eval { $foo->get_or_add_symbol('&blorg') };
164 } "doesn't leak on errors";