update some test things
[gitmo/Package-Stash-XS.git] / t / 21-leaks-debug.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use lib 't/lib';
5 use Test::More;
6 use Test::Fatal;
7 use Test::Requires 'Test::LeakTrace';
8
9 BEGIN { $^P |= 0x210 } # PERLDBf_SUBLINE
10
11 use Package::Stash;
12 use Symbol;
13
14 {
15     package Bar;
16 }
17
18 {
19     package Baz;
20     our $foo;
21     sub bar { }
22     use constant baz => 1;
23     our %quux = (a => 'b');
24 }
25
26 {
27     no_leaks_ok {
28         Package::Stash->new('Foo');
29     } "object construction doesn't leak";
30 }
31
32 {
33     no_leaks_ok {
34         Package::Stash->new('Bar');
35     } "object construction doesn't leak, with an existing package";
36 }
37
38 {
39     no_leaks_ok {
40         Package::Stash->new('Baz');
41     } "object construction doesn't leak, with an existing package with things in it";
42 }
43
44 {
45     my $foo = Package::Stash->new('Foo');
46     no_leaks_ok {
47         $foo->name;
48         $foo->namespace;
49     } "accessors don't leak";
50 }
51
52 {
53     my $foo = Package::Stash->new('Foo');
54     no_leaks_ok {
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";
60 }
61
62 {
63     my $foo = Package::Stash->new('Foo');
64     no_leaks_ok {
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";
71     is(exception {
72         is(Foo->code_init, 'foo', "sub installed correctly")
73     }, undef, "code_init exists");
74 }
75
76 {
77     my $foo = Package::Stash->new('Foo');
78     no_leaks_ok {
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";
85 }
86
87 {
88     my $foo = Package::Stash->new('Foo');
89     $foo->add_symbol("${_}glob") for ('$', '@', '%', '&', '');
90     no_leaks_ok {
91         $foo->remove_glob('glob');
92     } "remove_glob doesn't leak";
93 }
94
95 {
96     my $foo = Package::Stash->new('Foo');
97     no_leaks_ok {
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";
104 }
105
106 {
107     my $foo = Package::Stash->new('Foo');
108     no_leaks_ok {
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";
115 }
116
117 {
118     my $foo = Package::Stash->new('Foo');
119     ok(!$foo->has_symbol('$glob'));
120     ok(!$foo->has_symbol('@array_init'));
121     no_leaks_ok {
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"
130         : undef;
131     ok($foo->has_symbol('$glob'));
132     }
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');
138 }
139
140 {
141     my $foo = Package::Stash->new('Foo');
142     my $baz = Package::Stash->new('Baz');
143     no_leaks_ok {
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";
149 }
150
151 {
152     package Blah;
153     use constant 'baz';
154 }
155
156 {
157     my $foo = Package::Stash->new('Foo');
158     my $blah = Package::Stash->new('Blah');
159     no_leaks_ok {
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";
165 }
166
167 # mimic CMOP::create_anon_class
168 {
169     local $TODO = $] < 5.010 ? "deleting stashes is inherently leaky on 5.8"
170                              : undef;
171     my $i = 0;
172     no_leaks_ok {
173         $i++;
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";
179 }
180
181 {
182     my $foo = Package::Stash->new('Foo');
183     no_leaks_ok {
184         eval { $foo->get_or_add_symbol('&blorg') };
185     } "doesn't leak on errors";
186 }
187
188 done_testing;