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 7e16527f5307b87bc0620e1f440ee87e7c54e1ae..9e24440331643d8857c1f19824f68e90d9380f6e 100644 (file)
--- 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 d6895d214a3378e635c5a60911c56b614b672fc1..bfc659ab759d1732ffb848096f0fe4b905c38ef0 100644 (file)
--- 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';
+}