]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blob - t/16-huf.t
Convert t/30-scalar.t to the new testing framework
[perl/modules/Variable-Magic.git] / t / 16-huf.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More;
7
8 use Variable::Magic qw/wizard cast dispell VMG_UVAR/;
9
10 if (!VMG_UVAR) {
11  plan skip_all => 'No nice uvar magic for this perl';
12 }
13
14 eval "use Hash::Util::FieldHash";
15 if ($@) {
16  plan skip_all => 'Hash::Util::FieldHash required for testing uvar interaction';
17 } else {
18  plan tests => 12;
19  my $v = $Hash::Util::FieldHash::VERSION;
20  diag "Using Hash::Util::FieldHash $v" if defined $v;
21 }
22
23 Hash::Util::FieldHash::fieldhash(\my %h);
24
25 my $obj = { };
26 bless $obj, 'Variable::Magic::Test::Mock';
27 $h{$obj} = 5;
28
29 my ($w, $c) = (undef, 0);
30
31 eval { $w = wizard fetch => sub { ++$c }, store => sub { --$c } };
32 is($@, '',           'wizard with uvar doesn\'t croak');
33 ok(defined $w,       'wizard with uvar is defined');
34 is(ref $w, 'SCALAR', 'wizard with uvar is a scalar ref');
35
36 my $res = eval { cast %h, $w };
37 is($@, '', 'cast uvar magic on fieldhash doesn\'t croak');
38 ok($res,   'cast uvar magic on fieldhash is valid');
39
40 my $s = $h{$obj};
41 is($s, 5, 'fetch magic on fieldhash doesn\'t clobber');
42 is($c, 1, 'fetch magic on fieldhash');
43
44 $h{$obj} = 7;
45 is($c, 0,       'store magic on fieldhash');
46 is($h{$obj}, 7, 'store magic on fieldhash doesn\'t clobber'); # $c == 1
47
48 $res = eval { dispell %h, $w };
49 is($@, '', 'dispell uvar magic on fieldhash doesn\'t croak');
50 ok($res,   'dispell uvar magic on fieldhash is valid');
51
52 $h{$obj} = 11;
53 $s = $h{$obj};
54 is($s, 11, 'store/fetch on fieldhash after dispell still ok');