X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F30-scalar.t;h=bfc659ab759d1732ffb848096f0fe4b905c38ef0;hb=505fda7126b01811c0ca990552876a1c6d9dc7c3;hp=d6895d214a3378e635c5a60911c56b614b672fc1;hpb=4ae554f588e33ed5ca7d26edd634a03016c1a2d6;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/30-scalar.t b/t/30-scalar.t index d6895d2..bfc659a 100644 --- a/t/30-scalar.t +++ b/t/30-scalar.t @@ -3,9 +3,11 @@ use strict; use warnings; -use Test::More tests => (2 * 14 + 2) + 2 * (2 * 8 + 4) + 1; +use Config qw/%Config/; -use Variable::Magic qw/cast dispell/; +use Test::More tests => (2 * 14 + 2) + 2 * (2 * 8 + 4) + 3 + 1; + +use Variable::Magic qw/wizard cast dispell MGf_COPY/; use lib 't/lib'; use Variable::Magic::TestWatcher; @@ -97,3 +99,28 @@ is $b, 6, 'scalar: hash element: delete correctly'; check { $h{b} = 4 } { }, 'hash element: set after delete'; +SKIP: { + my $SKIP; + + unless (MGf_COPY) { + $SKIP = 'No copy magic for this perl'; + } elsif ($Config{useithreads} and $] le 5.008003) { + $SKIP = 'Causes havoc during global destruction for old threaded perls'; + } else { + eval "use Tie::Array"; + $SKIP = 'Tie::Array required to test clear magic on tied array values' if $@; + } + + skip $SKIP => 3 if $SKIP; + diag "Using Tie::Array $Tie::Array::VERSION" if defined $Tie::Array::VERSION; + + tie my @a, 'Tie::StdArray'; + $a[0] = $$; + + eval { + cast @a, wizard copy => sub { cast $_[3], $wiz; () }; + }; + is $@, '', 'cast copy magic on tied array'; + + check { delete $a[0] } [ qw/get clear free/ ], 'delete from tied array'; +}