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 }
  20
  21 Hash::Util::FieldHash::fieldhash(\my %h);
  22
  23 my $obj = { };
  24 bless $obj, 'Variable::Magic::Test::Mock';
  25 $h{$obj} = 5;
  26
  27 my ($w, $c) = (undef, 0);
  28
  29 eval { $w = wizard fetch => sub { ++$c }, store => sub { --$c } };
  30 ok(!$@,              "wizard with uvar doesn't croak ($@)");
  31 ok(defined $w,       'wizard with uvar is defined');
  32 is(ref $w, 'SCALAR', 'wizard with uvar is a scalar ref');
  33
  34 my $res = eval { cast %h, $w };
  35 ok(!$@,  "cast uvar magic on fieldhash doesn't croak ($@)");
  36 ok($res, 'cast uvar magic on fieldhash is valid');
  37
  38 my $s = $h{$obj};
  39 is($s, 5, 'fetch magic on fieldhash doesn\'t clobber');
  40 is($c, 1, 'fetch magic on fieldhash');
  41
  42 $h{$obj} = 7;
  43 is($c, 0,       'store magic on fieldhash');
  44 is($h{$obj}, 7, 'store magic on fieldhash doesn\'t clobber'); # $c == 1
  45
  46 $res = eval { dispell %h, $w };
  47 ok(!$@,  "dispell uvar magic on fieldhash doesn't croak ($@)");
  48 ok($res, 'dispell uvar magic on fieldhash is valid');
  49
  50 $h{$obj} = 11;
  51 $s = $h{$obj};
  52 is($s, 11, 'store/fetch on fieldhash after dispell still ok');