8 use Variable::Magic qw/wizard cast dispell VMG_UVAR VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/;
15 plan skip_all => 'uvar magic is required to test symbol table hooks';
21 . join (', ', map { <<CB;
24 return 0 if \$d->{guard};
25 local \$d->{guard} = 1;
26 push \@{\$mg{$_}}, \$_[2];
30 } qw/fetch store exists delete/);
32 $code .= ', data => sub { +{ guard => 0 } }';
48 our $what = @Hlagh::stuff;
52 is $@, "ok\n", 'stash: variables compiled fine';
54 fetch => [ qw/thing stuff/ ],
55 store => [ qw/thing stuff/ ],
56 }, 'stash: variables';
71 is $@, "ok\n", 'stash: function definitions compiled fine';
73 store => [ qw/eat shoot leave shoot/ ],
74 }, 'stash: function definitions';
91 is $@, "ok\n", 'stash: function calls compiled fine';
93 fetch => [ qw/eat shoot leave roam yawn roam/ ],
94 store => [ qw/eat shoot leave roam yawn roam/ ],
95 }, 'stash: function calls';
101 eval q{ Hlagh->shoot() };
103 is $@, '', 'stash: valid method call ran fine';
105 fetch => [ qw/shoot/ ],
106 }, 'stash: valid method call';
112 eval q{ Hlagh->shoot() };
114 is $@, '', 'stash: second valid method call ran fine';
116 fetch => [ qw/shoot/ ],
117 }, 'stash: second valid method call';
123 eval q{ my $meth = 'shoot'; Hlagh->$meth() };
125 is $@, '', 'stash: valid dynamic method call ran fine';
127 store => [ qw/shoot/ ],
128 }, 'stash: valid dynamic method call';
137 BEGIN { @ISA = 'Hlagh' }
141 is $@, '', 'inherited valid method call ran fine';
143 fetch => [ qw/ISA leave/ ],
144 }, 'stash: inherited valid method call';
150 eval q{ Hlagher->leave() };
152 is $@, '', 'second inherited valid method call ran fine';
153 is_deeply \%mg, { }, 'stash: second inherited valid method call doesn\'t call magic';
159 eval q{ Hlagher->shoot() };
161 is $@, '', 'inherited previously called valid method call ran fine';
163 fetch => [ qw/shoot/ ],
164 }, 'stash: inherited previously called valid method call';
170 eval q{ Hlagher->shoot() };
172 is $@, '', 'second inherited previously called valid method call ran fine';
173 is_deeply \%mg, { }, 'stash: second inherited previously called valid method call doesn\'t call magic';
179 eval q{ Hlagh->unknown() };
181 like $@, qr/^Can't locate object method "unknown" via package "Hlagh"/, 'stash: invalid method call croaked';
183 fetch => [ qw/unknown/ ],
184 store => [ qw/unknown AUTOLOAD/ ],
185 }, 'stash: invalid method call';
191 eval q{ my $meth = 'unknown_too'; Hlagh->$meth() };
193 like $@, qr/^Can't locate object method "unknown_too" via package "Hlagh"/, 'stash: invalid dynamic method call croaked';
195 store => [ qw/unknown_too AUTOLOAD/ ],
196 }, 'stash: invalid dynamic method call';
202 eval q{ Hlagher->also_unknown() };
204 like $@, qr/^Can't locate object method "also_unknown" via package "Hlagher"/, 'stash: invalid inherited method call croaked';
206 fetch => [ qw/also_unknown AUTOLOAD/ ],
207 }, 'stash: invalid method call';
215 undef &nevermentioned;
220 is $@, '', 'stash: delete executed fine';
223 qw/nevermentioned nevermentioned eat eat shoot shoot nevermentioned/
229 is_deeply \%mg, { }, 'stash: magic that remains at END time' if $run;
232 dispell %Hlagh::, $wiz;
237 use vars qw/$AUTOLOAD/;
239 sub AUTOLOAD { return $AUTOLOAD }
242 cast %AutoHlagh::, $wiz;
247 my $res = eval q{ AutoHlagh->autoloaded() };
249 is $@, '', 'stash: autoloaded method call ran fine';
250 is $res, 'AutoHlagh::autoloaded',
251 'stash: autoloaded method call returned the right thing';
253 fetch => [ qw/autoloaded/ ],
254 store => [ qw/autoloaded AUTOLOAD AUTOLOAD/ ],
255 }, 'stash: autoloaded method call';
262 BEGIN { @ISA = ('AutoHlagh') }
268 my $res = eval q{ AutoHlagher->also_autoloaded() };
270 is $@, '', 'stash: inherited autoloaded method call ran fine';
271 is $res, 'AutoHlagher::also_autoloaded',
272 'stash: inherited autoloaded method returned the right thing';
274 fetch => [ qw/also_autoloaded AUTOLOAD/ ],
275 store => [ qw/AUTOLOAD/ ],
276 }, 'stash: inherited autoloaded method call';
279 dispell %AutoHlagh::, $wiz;
282 . join (', ', map { <<CB;
285 return 0 if \$d->{guard};
286 local \$d->{guard} = 1;
287 is \$_[3], undef, 'stash: undef op';
291 } qw/fetch store exists delete/);
293 $code .= ', data => sub { +{ guard => 0 } }';
295 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_NAME;
306 is $@, "ok\n", 'stash: function call with op name compiled fine';
308 dispell %Hlagh::, $wiz;
310 $wiz = eval $code . ', op_info => ' . VMG_OP_INFO_OBJECT;
321 is $@, "ok\n", 'stash: function call with op object compiled fine';
323 dispell %Hlagh::, $wiz;