t/13-data.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 32;
   7
   8 use Variable::Magic qw/wizard getdata cast dispell SIG_MIN/;
   9
  10 my $c = 1;
  11
  12 my $sig = SIG_MIN;
  13 my $wiz = eval {
  14  wizard  sig => $sig,
  15         data => sub { return { foo => $_[1] || 12, bar => $_[3] || 27 } },
  16          get => sub { $c += $_[1]->{foo}; $_[1]->{foo} = $c },
  17          set => sub { $c += $_[1]->{bar}; $_[1]->{bar} = $c }
  18 };
  19 ok(!$@,                "wizard doesn't croak ($@)");
  20 ok(defined $wiz,       'wizard is defined');
  21 is(ref $wiz, 'SCALAR', 'wizard is a scalar ref');
  22
  23 my $a = 75;
  24 my $res = eval { cast $a, $wiz };
  25 ok(!$@,  "cast does't croak ($@)");
  26 ok($res, 'cast returns true');
  27
  28 my $data = eval { getdata $a, $wiz };
  29 ok(!$@,   "getdata from wizard doesn't croak ($@)");
  30 ok($res,  'getdata from wizard returns true');
  31 is_deeply($data, { foo => 12, bar => 27 },
  32           'getdata from wizard return value is ok');
  33
  34 $data = eval { getdata my $b, $wiz };
  35 ok(!$@,             "getdata from non-magical scalar doesn't croak ($@)");
  36 ok(!defined($data), 'getdata from non-magical scalar returns undef');
  37
  38 $data = eval { getdata $a, $sig };
  39 ok(!$@,   "getdata from sig doesn't croak ($@)");
  40 ok($res,  'getdata from sig returns true');
  41 is_deeply($data, { foo => 12, bar => 27 },
  42           'getdata from sig return value is ok');
  43
  44 my $b = $a;
  45 is($c,           13, 'get magic : pass data');
  46 is($data->{foo}, 13, 'get magic : data updated');
  47
  48 $a = 57;
  49 is($c,           40, 'set magic : pass data');
  50 is($data->{bar}, 40, 'set magic : pass data');
  51
  52 $data = eval { getdata $a, ($sig + 1) };
  53 ok(!$@,             "getdata from invalid sig doesn't croak ($@)");
  54 ok(!defined($data), 'getdata from invalid sig returns undef');
  55
  56 $data = eval { getdata $a, undef };
  57 ok($@,              "getdata from undef croaks ($@)");
  58 ok(!defined($data), 'getdata from undef returns undef');
  59
  60 $res = eval { dispell $a, $wiz };
  61 ok(!$@,  "dispell doesn't croak ($@)");
  62 ok($res, 'dispell returns true');
  63
  64 $res = eval { cast $a, $wiz, qw/z j t/ };
  65 ok(!$@,  "cast with arguments doesn't croak ($@)");
  66 ok($res, 'cast with arguments returns true');
  67
  68 $data = eval { getdata $a, $wiz };
  69 ok(!$@,   "getdata from wizard with arguments doesn't croak ($@)");
  70 ok($res,  'getdata from wizard with arguments returns true');
  71 is_deeply($data, { foo => 'z', bar => 't' },
  72           'getdata from wizard with arguments return value is ok');
  73
  74 $wiz = wizard get => sub { };
  75 dispell $a, $sig;
  76 $a = 63;
  77 $res = eval { cast $a, $wiz };
  78 ok(!$@,  "cast non-data wizard doesn't croak ($@)");
  79 ok($res, 'cast non-data wizard returns true');
  80
  81 $data = eval { getdata $a, $wiz };
  82 ok(!$@,             "getdata from non-data wizard doesn't croak ($@)");
  83 ok(!defined($data), 'getdata from non-data wizard invalid returns undef');