6 use Variable::Magic qw<wizard cast getdata dispell MGf_LOCAL VMG_UVAR>;
12 $tests += 4 * (4 + (MGf_LOCAL ? 1 : 0) + (VMG_UVAR ? 4 : 0));
19 package Variable::Magic::TestDestructor;
21 sub new { bless { }, shift }
23 sub DESTROY { ++$::destroyed }
26 sub D () { 'Variable::Magic::TestDestructor' }
31 my $w = wizard data => sub { $_[1] };
51 my $w = wizard data => sub { $_[1] };
63 $copy = getdata $x, $w;
82 my $w = wizard set => $obj;
99 # Test destruction of returned values
101 my @methods = qw<get set clear free>;
102 push @methods, 'local' if MGf_LOCAL;
103 push @methods, qw<fetch store exists delete> if VMG_UVAR;
106 scalar_lexical => 'my $x = 1; cast $x, $w',
107 scalar_global => 'our $X; local $X = 1; cast $X, $w',
108 array => 'my @a = (1); cast @a, $w',
109 hash => 'my %h = (a => 1); cast %h, $w',
113 $type{$_} = 'scalar_lexical' for qw<get set free>;
114 $type{$_} = 'scalar_global' for qw<local>;
115 $type{$_} = 'array' for qw<clear>;
116 $type{$_} = 'hash' for qw<fetch store exists delete>;
125 local => 'local $X = 2',
126 fetch => 'my $v = $h{a}',
127 store => '$h{a} = 2',
128 exists => 'my $e = exists $h{a}',
129 delete => 'my $d = delete $h{a}',
132 for my $meth (@methods) {
133 local $destroyed = 0;
136 my $w = wizard $meth => sub { return D->new };
138 my $init = $init{$type{$meth}};
139 my $trigger = $trigger{$meth};
142 if ($meth eq 'free') {
147 my $code = join ";\n", grep length, (
149 'is $destroyed, 0, "return from $meth, before trigger"',
150 $trigger . ', is($destroyed, 0, "return from $meth, after trigger")',
152 'is $destroyed, 1, "return from $meth, after trigger"',
161 is $destroyed, 1, "return from $meth, end";