Commit | Line | Data |
58710c0b |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
5 | use Test::Fatal; |
6 | use Test::Requires 'Test::LeakTrace'; |
7 | |
8 | use Package::Stash; |
9 | use Symbol; |
10 | |
11 | { |
12 | package Bar; |
13 | } |
14 | |
15 | { |
16 | package Baz; |
17 | our $foo; |
18 | sub bar { } |
19 | use constant baz => 1; |
20 | our %quux = (a => 'b'); |
21 | } |
22 | |
23 | { |
24 | no_leaks_ok { |
25 | Package::Stash->new('Foo'); |
26 | } "object construction doesn't leak"; |
27 | } |
28 | |
29 | { |
30 | no_leaks_ok { |
31 | Package::Stash->new('Bar'); |
32 | } "object construction doesn't leak, with an existing package"; |
33 | } |
34 | |
35 | { |
36 | no_leaks_ok { |
37 | Package::Stash->new('Baz'); |
38 | } "object construction doesn't leak, with an existing package with things in it"; |
39 | } |
40 | |
41 | { |
42 | my $foo = Package::Stash->new('Foo'); |
43 | no_leaks_ok { |
44 | $foo->name; |
45 | $foo->namespace; |
46 | } "accessors don't leak"; |
47 | } |
48 | |
49 | { |
50 | my $foo = Package::Stash->new('Foo'); |
51 | leaks_cmp_ok { |
52 | $foo->add_package_symbol('$scalar'); |
53 | $foo->add_package_symbol('@array'); |
54 | $foo->add_package_symbol('%hash'); |
55 | $foo->add_package_symbol('io'); |
56 | } '==', 4, "add_package_symbol doesn't leak"; |
57 | } |
58 | |
59 | { |
60 | my $foo = Package::Stash->new('Foo'); |
61 | leaks_cmp_ok { |
62 | $foo->add_package_symbol('$scalar_init' => 1); |
63 | $foo->add_package_symbol('@array_init' => []); |
64 | $foo->add_package_symbol('%hash_init' => {}); |
65 | # hmmm, wonder why this coderef isn't treated as a leak |
66 | $foo->add_package_symbol('&code_init' => sub { "foo" }); |
67 | $foo->add_package_symbol('io_init' => Symbol::geniosym); |
68 | } '==', 9, "add_package_symbol doesn't leak"; |
69 | is(exception { |
70 | is(Foo->code_init, 'foo', "sub installed correctly") |
71 | }, undef, "code_init exists"); |
72 | } |
73 | |
74 | { |
75 | my $foo = Package::Stash->new('Foo'); |
76 | no_leaks_ok { |
77 | $foo->remove_package_symbol('$scalar_init'); |
78 | $foo->remove_package_symbol('@array_init'); |
79 | $foo->remove_package_symbol('%hash_init'); |
80 | $foo->remove_package_symbol('&code_init'); |
81 | $foo->remove_package_symbol('io_init'); |
82 | } "remove_package_symbol doesn't leak"; |
83 | } |
84 | |
85 | { |
86 | my $foo = Package::Stash->new('Foo'); |
87 | $foo->add_package_symbol("${_}glob") for ('$', '@', '%', '&', ''); |
88 | no_leaks_ok { |
89 | $foo->remove_package_glob('glob'); |
90 | } "remove_package_glob doesn't leak"; |
91 | } |
92 | |
93 | { |
94 | my $foo = Package::Stash->new('Foo'); |
95 | no_leaks_ok { |
96 | $foo->has_package_symbol('io'); |
97 | $foo->has_package_symbol('%hash'); |
98 | $foo->has_package_symbol('@array_init'); |
99 | $foo->has_package_symbol('$glob'); |
100 | $foo->has_package_symbol('&something_else'); |
101 | } "has_package_symbol doesn't leak"; |
102 | } |
103 | |
104 | { |
105 | my $foo = Package::Stash->new('Foo'); |
106 | no_leaks_ok { |
107 | $foo->get_package_symbol('io'); |
108 | $foo->get_package_symbol('%hash'); |
109 | $foo->get_package_symbol('@array_init'); |
110 | $foo->get_package_symbol('$glob'); |
111 | $foo->get_package_symbol('&something_else'); |
112 | } "get_package_symbol doesn't leak"; |
113 | } |
114 | |
115 | { |
116 | my $foo = Package::Stash->new('Foo'); |
117 | ok(!$foo->has_package_symbol('$glob')); |
118 | ok(!$foo->has_package_symbol('@array_init')); |
119 | no_leaks_ok { |
120 | $foo->get_or_add_package_symbol('io'); |
121 | $foo->get_or_add_package_symbol('%hash'); |
c5e221f9 |
122 | my @super = ('Exporter'); |
123 | @{$foo->get_or_add_package_symbol('@ISA')} = @super; |
58710c0b |
124 | $foo->get_or_add_package_symbol('$glob'); |
125 | } "get_or_add_package_symbol doesn't leak"; |
126 | ok($foo->has_package_symbol('$glob')); |
127 | is(ref($foo->get_package_symbol('$glob')), 'SCALAR'); |
c5e221f9 |
128 | ok($foo->has_package_symbol('@ISA')); |
129 | is(ref($foo->get_package_symbol('@ISA')), 'ARRAY'); |
130 | is_deeply($foo->get_package_symbol('@ISA'), ['Exporter']); |
131 | isa_ok('Foo', 'Exporter'); |
58710c0b |
132 | } |
133 | |
134 | { |
135 | my $foo = Package::Stash->new('Foo'); |
136 | my $baz = Package::Stash->new('Baz'); |
137 | no_leaks_ok { |
138 | $foo->list_all_package_symbols; |
139 | $foo->list_all_package_symbols('SCALAR'); |
140 | $foo->list_all_package_symbols('CODE'); |
141 | $baz->list_all_package_symbols('CODE'); |
142 | } "list_all_package_symbols doesn't leak"; |
143 | } |
144 | |
145 | done_testing; |