X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F25-copy.t;fp=t%2F25-copy.t;h=58cf8e91db6df1ce407174a6a2ebe20528ba8937;hb=183e73e0590b46550dfa6fdd4b6cf3280c1a5877;hp=0000000000000000000000000000000000000000;hpb=0f6f5717615db7019992273892a3360bfcc5ca7f;p=perl%2Fmodules%2FVariable-Magic.git

diff --git a/t/25-copy.t b/t/25-copy.t
new file mode 100644
index 0000000..58cf8e9
--- /dev/null
+++ b/t/25-copy.t
@@ -0,0 +1,63 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Variable::Magic qw/wizard cast MGf_COPY/;
+
+if (!MGf_COPY) {
+ plan skip_all => "this perl doesn't handle copy magic";
+} else {
+ plan tests => 16;
+}
+
+my $c = 0;
+my $wiz = wizard copy => sub { ++$c };
+ok($c == 0, 'copy : create wizard');
+
+use Tie::Array;
+
+tie my @a, 'Tie::StdArray';
+cast @a, $wiz;
+ok($c == 0, 'copy (array) : cast');
+
+my $n = time;
+$a[0] = $n;
+ok($c == 1, 'copy (array) : store element');
+
+my $e = exists $a[0];
+ok($c == 2, 'copy (array) : exists element');
+ok($e,      'copy (array) : exists element, really'); 
+
+my $b = $a[0];
+ok($c == 3, 'copy (array) : fetch element');
+ok($b == $n, 'copy (array) : fetch element correctly');
+
+use Tie::Hash;
+
+$c = 0;
+
+tie my %h, 'Tie::StdHash';
+cast %h, $wiz;
+ok($c == 0, 'copy (hash) : cast');
+
+my ($k, $v) = (time, int rand time);
+$h{$k} = $v;
+ok($c == 1, 'copy (hash) : store element');
+
+$e = exists $h{$k};
+ok($c == 2, 'copy (hash) : exists element');
+ok($e,      'copy (hash) : exists element, really');
+
+my $w = $h{$k};
+ok($c == 3, 'copy (hash) : fetch element');
+ok($w == $v, 'copy (hash) : fetch element correctly');
+
+my ($K, $V) = each %h;
+ok($c == 4, 'copy (hash) : iterate');
+ok($k == $K && $v == $V, 'copy (hash) : iterate correctly');
+
+delete $h{$k};
+ok($c == 5, 'copy (hash) : delete');