1#!perl -T 2 3use strict; 4use warnings; 5 6use Test::More; 7 8use Variable::Magic qw/cast dispell MGf_COPY/; 9 10if (MGf_COPY) { 11 plan tests => 2 + ((2 * 5 + 3) + (2 * 2 + 1)) + (2 * 9 + 6) + 1; 12} else { 13 plan skip_all => 'No copy magic for this perl'; 14} 15 16use lib 't/lib'; 17use Variable::Magic::TestWatcher; 18use Variable::Magic::TestValue; 19 20my $wiz = init_watcher 'copy', 'copy'; 21 22SKIP: { 23 eval "use Tie::Array"; 24 skip 'Tie::Array required to test copy magic on arrays' 25 => (2 * 5 + 3) + (2 * 2 + 1) if $@; 26 diag "Using Tie::Array $Tie::Array::VERSION" if defined $Tie::Array::VERSION; 27 28 tie my @a, 'Tie::StdArray'; 29 @a = (1 .. 10); 30 31 my $res = watch { cast @a, $wiz } { }, 'cast on tied array'; 32 ok $res, 'copy: cast on tied array succeeded'; 33 34 watch { $a[3] = 13 } { copy => 1 }, 'tied array store'; 35 36 my $s = watch { $a[3] } { copy => 1 }, 'tied array fetch'; 37 is $s, 13, 'copy: tied array fetch correctly'; 38 39 $s = watch { exists $a[3] } { copy => 1 }, 'tied array exists'; 40 ok $s, 'copy: tied array exists correctly'; 41 42 watch { undef @a } { }, 'tied array undef'; 43 44 { 45 tie my @val, 'Tie::StdArray'; 46 @val = (4 .. 6); 47 48 my $wv = init_value @val, 'copy', 'copy'; 49 50 value { $val[3] = 8 } [ 4 .. 6 ]; 51 52 dispell @val, $wv; 53 is_deeply \@val, [ 4 .. 6, 8 ], 'copy: value after'; 54 } 55} 56 57SKIP: { 58 eval "use Tie::Hash"; 59 skip 'Tie::Hash required to test copy magic on hashes' => 2 * 9 + 6 if $@; 60 diag "Using Tie::Hash $Tie::Hash::VERSION" if defined $Tie::Hash::VERSION; 61 62 tie my %h, 'Tie::StdHash'; 63 %h = (a => 1, b => 2, c => 3); 64 65 my $res = watch { cast %h, $wiz } { }, 'cast on tied hash'; 66 ok $res, 'copy: cast on tied hash succeeded'; 67 68 watch { $h{b} = 7 } { copy => 1 }, 'tied hash store'; 69 70 my $s = watch { $h{c} } { copy => 1 }, 'tied hash fetch'; 71 is $s, 3, 'copy: tied hash fetch correctly'; 72 73 $s = watch { exists $h{a} } { copy => 1 }, 'tied hash exists'; 74 ok $s, 'copy: tied hash exists correctly'; 75 76 $s = watch { delete $h{b} } { copy => 1 }, 'tied hash delete'; 77 is $s, 7, 'copy: tied hash delete correctly'; 78 79 watch { my ($k, $v) = each %h } { copy => 1 }, 'tied hash each'; 80 81 my @k = watch { keys %h } { }, 'tied hash keys'; 82 is_deeply [ sort @k ], [ qw/a c/ ], 'copy: tied hash keys correctly'; 83 84 my @v = watch { values %h } { copy => 2 }, 'tied hash values'; 85 is_deeply [ sort { $a <=> $b } @v ], [ 1, 3 ], 'copy: tied hash values correctly'; 86 87 watch { undef %h } { }, 'tied hash undef'; 88} 89