t/13-data.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 35;
   7
   8 use Variable::Magic qw<wizard getdata cast dispell>;
   9
  10 my $c = 1;
  11
  12 my $wiz = eval {
  13  wizard data => sub { return { foo => $_[1] || 12, bar => $_[3] || 27 } },
  14          get => sub { $c += $_[1]->{foo}; $_[1]->{foo} = $c },
  15          set => sub { $c += $_[1]->{bar}; $_[1]->{bar} = $c }
  16 };
  17 is($@, '',             'wizard doesn\'t croak');
  18 ok(defined $wiz,       'wizard is defined');
  19 is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
  20
  21 my $a = 75;
  22 my $res = eval { cast $a, $wiz };
  23 is($@, '', 'cast doesn\'t croak');
  24 ok($res,   'cast returns true');
  25
  26 my $data = eval { getdata my $b, $wiz };
  27 is($@, '',       'getdata from non-magical scalar doesn\'t croak');
  28 is($data, undef, 'getdata from non-magical scalar returns undef');
  29
  30 $data = eval { getdata $a, $wiz };
  31 is($@, '', 'getdata from wizard doesn\'t croak');
  32 ok($res,   'getdata from wizard returns true');
  33 is_deeply($data, { foo => 12, bar => 27 },
  34            'getdata from wizard return value is ok');
  35
  36 my $b = $a;
  37 is($c,           13, 'get magic : pass data');
  38 is($data->{foo}, 13, 'get magic : data updated');
  39
  40 $a = 57;
  41 is($c,           40, 'set magic : pass data');
  42 is($data->{bar}, 40, 'set magic : pass data');
  43
  44 $data = eval { getdata $a, \"blargh" };
  45 like($@, qr/Invalid\s+wizard\s+object\s+at\s+\Q$0\E/, 'getdata from invalid wizard croaks');
  46 is($data, undef, 'getdata from invalid wizard returns undef');
  47
  48 $data = eval { getdata $a, undef };
  49 like($@, qr/Invalid\s+wizard\s+object\s+at\s+\Q$0\E/, 'getdata from undef croaks');
  50 is($data, undef, 'getdata from undef doesn\'t return anything');
  51
  52 $res = eval { dispell $a, $wiz };
  53 is($@, '', 'dispell doesn\'t croak');
  54 ok($res,   'dispell returns true');
  55
  56 $res = eval { cast $a, $wiz, qw<z j t> };
  57 is($@, '', 'cast with arguments doesn\'t croak');
  58 ok($res,   'cast with arguments returns true');
  59
  60 $data = eval { getdata $a, $wiz };
  61 is($@, '', 'getdata from wizard with arguments doesn\'t croak');
  62 ok($res,   'getdata from wizard with arguments returns true');
  63 is_deeply($data, { foo => 'z', bar => 't' },
  64            'getdata from wizard with arguments return value is ok');
  65
  66 dispell $a, $wiz;
  67
  68 $wiz = wizard get => sub { };
  69 $a = 63;
  70 $res = eval { cast $a, $wiz };
  71 is($@, '', 'cast non-data wizard doesn\'t croak');
  72 ok($res,   'cast non-data wizard returns true');
  73
  74 my @data = eval { getdata $a, $wiz };
  75 is($@,            '',  'getdata from non-data wizard doesn\'t croak');
  76 is_deeply(\@data, [ ], 'getdata from non-data wizard invalid returns undef');
  77
  78 $wiz = wizard data => sub { ++$_[1] };
  79 my ($di, $ei) = (1, 10);
  80 my ($d, $e);
  81 cast $d, $wiz, $di;
  82 cast $e, $wiz, $ei;
  83 my $dd = getdata $d, $wiz;
  84 my $ed = getdata $e, $wiz;
  85 is($dd, 2,  'data from d is what we expected');
  86 is($di, 2,  'cast arguments from d were passed by alias');
  87 is($ed, 11, 'data from e is what we expected');
  88 is($ei, 11, 'cast arguments from e were passed by alias');
  89 $di *= 2;
  90 $dd = getdata $d, $wiz;
  91 $ed = getdata $e, $wiz;
  92 is($dd, 2,  'data from d wasn\'t changed');
  93 is($ed, 11, 'data from e wasn\'t changed');