Commit | Line | Data |
d2d3faf4 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
5 | |
e94260da |
6 | use Package::Stash; |
d2d3faf4 |
7 | |
8 | { |
a1c10d3a |
9 | BEGIN { |
34b3fdd2 |
10 | my $stash = Package::Stash->new('Hash'); |
a1c10d3a |
11 | my $val = $stash->get_package_symbol('%foo'); |
12 | is($val, undef, "got nothing yet"); |
13 | } |
14 | { |
15 | no warnings 'void', 'once'; |
34b3fdd2 |
16 | %Hash::foo; |
a1c10d3a |
17 | } |
18 | BEGIN { |
34b3fdd2 |
19 | my $stash = Package::Stash->new('Hash'); |
a1c10d3a |
20 | my $val = $stash->get_package_symbol('%foo'); |
21 | is(ref($val), 'HASH', "got something"); |
22 | $val->{bar} = 1; |
23 | is_deeply($stash->get_package_symbol('%foo'), {bar => 1}, |
34b3fdd2 |
24 | "got the right variable"); |
25 | is_deeply(\%Hash::foo, {bar => 1}, |
26 | "stash has the right variable"); |
a1c10d3a |
27 | } |
d2d3faf4 |
28 | } |
29 | |
30 | { |
a1c10d3a |
31 | BEGIN { |
34b3fdd2 |
32 | my $stash = Package::Stash->new('Array'); |
a1c10d3a |
33 | my $val = $stash->get_package_symbol('@foo'); |
34b3fdd2 |
34 | is($val, undef, "got nothing yet"); |
a1c10d3a |
35 | } |
36 | { |
37 | no warnings 'void', 'once'; |
34b3fdd2 |
38 | @Array::foo; |
a1c10d3a |
39 | } |
40 | BEGIN { |
34b3fdd2 |
41 | my $stash = Package::Stash->new('Array'); |
a1c10d3a |
42 | my $val = $stash->get_package_symbol('@foo'); |
43 | is(ref($val), 'ARRAY', "got something"); |
44 | push @$val, 1; |
45 | is_deeply($stash->get_package_symbol('@foo'), [1], |
34b3fdd2 |
46 | "got the right variable"); |
47 | is_deeply(\@Array::foo, [1], |
48 | "stash has the right variable"); |
49 | } |
50 | } |
51 | |
52 | { |
53 | BEGIN { |
54 | my $stash = Package::Stash->new('Scalar'); |
55 | my $val = $stash->get_package_symbol('$foo'); |
56 | is($val, undef, "got nothing yet"); |
57 | } |
58 | { |
59 | no warnings 'void', 'once'; |
60 | $Scalar::foo; |
61 | } |
62 | BEGIN { |
63 | my $stash = Package::Stash->new('Scalar'); |
64 | my $val = $stash->get_package_symbol('$foo'); |
65 | is(ref($val), 'SCALAR', "got something"); |
66 | $$val = 1; |
67 | is_deeply($stash->get_package_symbol('$foo'), \1, |
68 | "got the right variable"); |
69 | is($Scalar::foo, 1, |
70 | "stash has the right variable"); |
a1c10d3a |
71 | } |
d2d3faf4 |
72 | } |
73 | |
e55803fc |
74 | { |
34b3fdd2 |
75 | BEGIN { |
76 | my $stash = Package::Stash->new('Io'); |
77 | my $val = $stash->get_package_symbol('FOO'); |
78 | is($val, undef, "got nothing yet"); |
79 | } |
80 | { |
81 | no warnings 'void', 'once'; |
82 | package Io; |
83 | fileno(FOO); |
84 | } |
85 | BEGIN { |
86 | my $stash = Package::Stash->new('Io'); |
87 | my $val = $stash->get_package_symbol('FOO'); |
88 | isa_ok($val, 'IO'); |
89 | my $str = "foo"; |
90 | open $val, '<', \$str; |
91 | is(readline($stash->get_package_symbol('FOO')), "foo", |
92 | "got the right variable"); |
93 | { |
94 | package Io; |
95 | ::isa_ok(*FOO{IO}, 'IO'); |
96 | } |
97 | } |
98 | } |
99 | |
100 | TODO: { |
101 | # making TODO tests at a mixture of BEGIN and runtime is irritating |
102 | my $_TODO; |
103 | BEGIN { $_TODO = "obviously I don't understand this well enough"; } |
104 | BEGIN { $TODO = $_TODO; } |
105 | $TODO = $_TODO; |
106 | BEGIN { |
107 | my $stash = Package::Stash->new('Code'); |
108 | my $val = $stash->get_package_symbol('&foo'); |
109 | is($val, undef, "got nothing yet"); |
110 | } |
111 | { |
112 | no warnings 'void', 'once'; |
113 | \&Code::foo; |
114 | } |
115 | BEGIN { |
116 | my $stash = Package::Stash->new('Code'); |
117 | my $val = $stash->get_package_symbol('&foo'); |
118 | undef $TODO; |
119 | is(ref($val), 'CODE', "got something"); |
120 | $TODO = $_TODO; |
121 | SKIP: { |
122 | eval "require PadWalker" |
123 | or skip "needs PadWalker", 1; |
124 | # avoid padwalker segfault |
125 | if (!defined($val)) { |
126 | fail("got the right variable"); |
127 | } |
128 | else { |
129 | PadWalker::set_closed_over($val, {'$x' => 1}); |
130 | is_deeply({PadWalker::closed_over($stash->get_package_symbol('&foo'))}, {'$x' => 1}, |
131 | "got the right variable"); |
132 | is_deeply({PadWalker::closed_over(\&Code::foo)}, {'$x' => 1}, |
133 | "stash has the right variable"); |
134 | } |
135 | } |
136 | } |
137 | BEGIN { undef $TODO; } |
138 | undef $TODO; |
139 | } |
140 | |
141 | { |
142 | my $stash = Package::Stash->new('Hash::Vivify'); |
e55803fc |
143 | my $val = $stash->get_or_add_package_symbol('%foo'); |
144 | is(ref($val), 'HASH', "got something"); |
145 | $val->{bar} = 1; |
146 | is_deeply($stash->get_or_add_package_symbol('%foo'), {bar => 1}, |
34b3fdd2 |
147 | "got the right variable"); |
148 | no warnings 'once'; |
149 | is_deeply(\%Hash::Vivify::foo, {bar => 1}, |
150 | "stash has the right variable"); |
e55803fc |
151 | } |
152 | |
153 | { |
34b3fdd2 |
154 | my $stash = Package::Stash->new('Array::Vivify'); |
e55803fc |
155 | my $val = $stash->get_or_add_package_symbol('@foo'); |
156 | is(ref($val), 'ARRAY', "got something"); |
157 | push @$val, 1; |
158 | is_deeply($stash->get_or_add_package_symbol('@foo'), [1], |
34b3fdd2 |
159 | "got the right variable"); |
160 | no warnings 'once'; |
161 | is_deeply(\@Array::Vivify::foo, [1], |
162 | "stash has the right variable"); |
163 | } |
164 | |
165 | { |
166 | my $stash = Package::Stash->new('Scalar::Vivify'); |
167 | my $val = $stash->get_or_add_package_symbol('$foo'); |
168 | is(ref($val), 'SCALAR', "got something"); |
169 | $$val = 1; |
170 | is_deeply($stash->get_or_add_package_symbol('$foo'), \1, |
171 | "got the right variable"); |
172 | no warnings 'once'; |
173 | is($Scalar::Vivify::foo, 1, |
174 | "stash has the right variable"); |
175 | } |
176 | |
177 | { |
178 | BEGIN { |
179 | my $stash = Package::Stash->new('Io::Vivify'); |
180 | my $val = $stash->get_or_add_package_symbol('FOO'); |
181 | isa_ok($val, 'IO'); |
182 | my $str = "foo"; |
183 | open $val, '<', \$str; |
184 | is(readline($stash->get_package_symbol('FOO')), "foo", |
185 | "got the right variable"); |
186 | } |
187 | { |
188 | package Io::Vivify; |
189 | no warnings 'once'; |
190 | ::isa_ok(*FOO{IO}, 'IO'); |
191 | } |
e55803fc |
192 | } |
193 | |
d2d3faf4 |
194 | done_testing; |