From: Vincent Pit <vince@profvince.com>
Date: Fri, 20 Mar 2009 13:47:51 +0000 (+0100)
Subject: Revert "clear magic only applies to arrays and hashes"
X-Git-Tag: v0.33~10
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=505fda7126b01811c0ca990552876a1c6d9dc7c3;p=perl%2Fmodules%2FVariable-Magic.git

Revert "clear magic only applies to arrays and hashes"

This reverts commit 4affb8304508fab43fb2247aa6d4d842c5fb82f2.

And test that deleting from a tied array may trigger clear magic on the value.
---

diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm
index 7e16527..9e24440 100644
--- a/lib/Variable/Magic.pm
+++ b/lib/Variable/Magic.pm
@@ -125,7 +125,7 @@ The callback has then to return the length as an integer.
 
 C<clear>
 
-This magic is invoked when a container variable is reset, i.e. when an array or a hash is emptied.
+This magic is invoked when the variable is reset, such as when an array is emptied.
 Please note that this is different from undefining the variable, even though the magic is called when the clearing is a result of the undefine (e.g. for an array, but actually a bug prevent it to work before perl 5.9.5 - see the L<history|/PERL MAGIC HISTORY>).
 
 =item *
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';
+}