t/25-copy.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use Variable::Magic qw/wizard cast MGf_COPY/;
   9
  10 if (!MGf_COPY) {
  11  plan skip_all => "this perl doesn't handle copy magic";
  12 } else {
  13  plan tests => 16;
  14 }
  15
  16 my $c = 0;
  17 my $wiz = wizard copy => sub { ++$c };
  18 ok($c == 0, 'copy : create wizard');
  19
  20 use Tie::Array;
  21
  22 tie my @a, 'Tie::StdArray';
  23 cast @a, $wiz;
  24 ok($c == 0, 'copy (array) : cast');
  25
  26 my $n = time;
  27 $a[0] = $n;
  28 ok($c == 1, 'copy (array) : store element');
  29
  30 my $e = exists $a[0];
  31 ok($c == 2, 'copy (array) : exists element');
  32 ok($e,      'copy (array) : exists element, really');
  33
  34 my $b = $a[0];
  35 ok($c == 3, 'copy (array) : fetch element');
  36 ok($b == $n, 'copy (array) : fetch element correctly');
  37
  38 use Tie::Hash;
  39
  40 $c = 0;
  41
  42 tie my %h, 'Tie::StdHash';
  43 cast %h, $wiz;
  44 ok($c == 0, 'copy (hash) : cast');
  45
  46 my ($k, $v) = (time, int rand time);
  47 $h{$k} = $v;
  48 ok($c == 1, 'copy (hash) : store element');
  49
  50 $e = exists $h{$k};
  51 ok($c == 2, 'copy (hash) : exists element');
  52 ok($e,      'copy (hash) : exists element, really');
  53
  54 my $w = $h{$k};
  55 ok($c == 3, 'copy (hash) : fetch element');
  56 ok($w == $v, 'copy (hash) : fetch element correctly');
  57
  58 my ($K, $V) = each %h;
  59 ok($c == 4, 'copy (hash) : iterate');
  60 ok($k == $K && $v == $V, 'copy (hash) : iterate correctly');
  61
  62 delete $h{$k};
  63 ok($c == 5, 'copy (hash) : delete');