Commit | Line | Data |
093a8e73 |
1 | #!/usr/bin/env perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use Devel::GlobalDestruction (); |
6 | use Scalar::Util (); |
7 | use Variable::Magic (); |
8 | use Carp (); |
9 | |
10 | BEGIN { |
11 | package Foo; |
12 | |
13 | my $wiz; |
14 | $wiz = Variable::Magic::wizard |
15 | data => sub { $_[1] }, |
16 | get => sub { |
17 | Carp::cluck "get fired"; |
18 | Scalar::Util::weaken($_[1]->{reference}{other_side} = ${$_[0]}); |
19 | Scalar::Util::weaken($_[1]->{reference}); |
20 | Variable::Magic::dispell ${$_[0]}, $wiz; |
21 | }; |
22 | |
23 | sub DESTROY { |
24 | return if Devel::GlobalDestruction::in_global_destruction(); |
25 | Carp::cluck "DESTROY\n"; |
26 | |
27 | my $self = shift; |
28 | |
29 | if (ref $self->{other_side} && $self->{other_side}{reference}) { |
30 | if ( |
31 | Scalar::Util::refaddr($self->{other_side}{reference}) |
32 | eq Scalar::Util::refaddr($self) |
33 | ) { |
34 | warn "Enlivening"; |
35 | $self->{other_side}{reference} = $self; |
36 | Variable::Magic::cast( |
37 | $self->{other_side}{reference}, $wiz, $self->{other_side} |
38 | ); |
39 | delete $self->{other_side}; |
40 | } |
41 | } |
42 | } |
43 | } |
44 | |
45 | my $near = {}; |
46 | my $far = $near->{reference} = bless({ other_side => $near }, 'Foo'); |
47 | warn $near->{reference}; |
48 | warn $far; |
49 | Scalar::Util::weaken($near->{reference}); |
50 | warn "Setup done\n"; |
51 | undef($far); |
52 | my $copy = $near->{reference}; |
53 | warn $copy; |
54 | warn Scalar::Util::isweak($near->{reference}); |
55 | warn $near->{reference}; |
56 | warn $near->{reference}; |
57 | undef($near); |
58 | warn "Done\n"; |