]> git.vpit.fr Git - perl/modules/Variable-Magic.git/blob - t/25-copy.t
58cf8e91db6df1ce407174a6a2ebe20528ba8937
[perl/modules/Variable-Magic.git] / 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');