8 use Variable::Magic qw<
10 VMG_UVAR VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT
18 plan skip_all => 'uvar magic is required to test symbol table hooks';
24 . join (', ', map { <<CB;
27 return 0 if \$d->{guard};
28 local \$d->{guard} = 1;
29 push \@{\$mg{$_}}, \$_[2];
33 } qw<fetch store exists delete>);
35 $code .= ', data => sub { +{ guard => 0 } }';
51 our $what = @Hlagh::stuff;
55 is $@, "ok\n", 'stash: variables compiled fine';
57 fetch => [ qw<thing stuff> ],
58 store => [ qw<thing stuff> ],
59 }, 'stash: variables';
74 is $@, "ok\n", 'stash: function definitions compiled fine';
76 store => [ qw<eat shoot leave shoot> ],
77 }, 'stash: function definitions';
94 my @calls = qw<eat shoot leave roam yawn roam>;
96 if ("$]" >= 5.011_002 && "$]" < 5.021_004) {
98 @store = map { ($_) x 2 } @calls;
104 is $@, "ok\n", 'stash: function calls compiled fine';
108 }, 'stash: function calls';
114 eval q{ Hlagh->shoot() };
116 is $@, '', 'stash: valid method call ran fine';
117 my %expected = ( fetch => [ qw<shoot> ] );
118 # Typeglob reification may cause a store in 5.28+
119 if ("$]" >= 5.027 && %mg == 2) {
120 $expected{store} = $expected{fetch};
122 is_deeply \%mg, \%expected, 'stash: valid method call';
128 eval q{ Hlagh->shoot() };
130 is $@, '', 'stash: second valid method call ran fine';
132 fetch => [ qw<shoot> ],
133 }, 'stash: second valid method call';
139 eval q{ my $meth = 'shoot'; Hlagh->$meth() };
141 is $@, '', 'stash: valid dynamic method call ran fine';
143 store => [ qw<shoot> ],
144 }, 'stash: valid dynamic method call';
153 BEGIN { @ISA = 'Hlagh' }
157 is $@, '', 'inherited valid method call ran fine';
159 fetch => [ qw<ISA leave> ],
160 }, 'stash: inherited valid method call';
166 eval q{ Hlagher->leave() };
168 is $@, '', 'second inherited valid method call ran fine';
169 is_deeply \%mg, { }, 'stash: second inherited valid method call doesn\'t call magic';
175 eval q{ Hlagher->shoot() };
177 is $@, '', 'inherited previously called valid method call ran fine';
179 fetch => [ qw<shoot> ],
180 }, 'stash: inherited previously called valid method call';
186 eval q{ Hlagher->shoot() };
188 is $@, '', 'second inherited previously called valid method call ran fine';
189 is_deeply \%mg, { }, 'stash: second inherited previously called valid method call doesn\'t call magic';
195 eval q{ Hlagh->unknown() };
197 like $@, qr/^Can't locate object method "unknown" via package "Hlagh"/, 'stash: invalid method call croaked';
199 fetch => [ qw<unknown> ],
200 store => [ qw<unknown AUTOLOAD> ],
201 }, 'stash: invalid method call';
207 eval q{ my $meth = 'unknown_too'; Hlagh->$meth() };
209 like $@, qr/^Can't locate object method "unknown_too" via package "Hlagh"/, 'stash: invalid dynamic method call croaked';
211 store => [ qw<unknown_too AUTOLOAD> ],
212 }, 'stash: invalid dynamic method call';
218 eval q{ Hlagher->also_unknown() };
220 like $@, qr/^Can't locate object method "also_unknown" via package "Hlagher"/, 'stash: invalid inherited method call croaked';
222 fetch => [ qw<also_unknown AUTOLOAD> ],
223 }, 'stash: invalid method call';
229 my @expected_stores = qw<nevermentioned eat shoot>;
230 @expected_stores = map { ($_) x 2 } @expected_stores if "$]" < 5.017_004;
231 push @expected_stores, 'nevermentioned' if "$]" < 5.017_001;
235 undef &nevermentioned;
240 is $@, '', 'stash: delete executed fine';
241 is_deeply \%mg, { store => \@expected_stores }, 'stash: delete';
245 is_deeply \%mg, { }, 'stash: magic that remains at END time' if $run;
248 dispell %Hlagh::, $wiz;
253 use vars qw<$AUTOLOAD>;
255 sub AUTOLOAD { return $AUTOLOAD }
258 cast %AutoHlagh::, $wiz;
263 my $res = eval q{ AutoHlagh->autoloaded() };
265 is $@, '', 'stash: autoloaded method call ran fine';
266 is $res, 'AutoHlagh::autoloaded',
267 'stash: autoloaded method call returned the right thing';
269 fetch => [ qw<autoloaded> ],
270 store => [ qw<autoloaded AUTOLOAD AUTOLOAD> ],
271 }, 'stash: autoloaded method call';
278 BEGIN { @ISA = ('AutoHlagh') }
284 my $res = eval q{ AutoHlagher->also_autoloaded() };
286 is $@, '', 'stash: inherited autoloaded method call ran fine';
287 is $res, 'AutoHlagher::also_autoloaded',
288 'stash: inherited autoloaded method returned the right thing';
290 fetch => [ qw<also_autoloaded AUTOLOAD> ],
291 store => [ qw<AUTOLOAD> ],
292 }, 'stash: inherited autoloaded method call';
295 dispell %AutoHlagh::, $wiz;
299 . join (', ', map { <<CB;
302 return 0 if \$d->{guard};
303 local \$d->{guard} = 1;
308 } qw<fetch store exists delete>);
310 my $uo_exp = "$]" >= 5.011_002 && "$]" < 5.021_004 ? 3 : 2;
312 $code .= ', data => sub { +{ guard => 0 } }';
314 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_NAME;
319 is $uo, 0, 'stash: no undef op before function call with op name';
325 is $@, "ok\n", 'stash: function call with op name compiled fine';
326 is $uo, $uo_exp, 'stash: undef op after function call with op name';
328 dispell %Hlagh::, $wiz;
329 is $uo, $uo_exp, 'stash: undef op after dispell for function call with op name';
333 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_OBJECT;
338 is $uo, 0, 'stash: no undef op before function call with op object';
344 is $@, "ok\n", 'stash: function call with op object compiled fine';
346 'stash: undef op after dispell for function call with op object';
348 dispell %Hlagh::, $wiz;
350 'stash: undef op after dispell for function call with op object';