Commit | Line | Data |
0373380c |
1 | use Test::More qw(no_plan); |
2 | use Scalar::Util qw(refaddr weaken isweak); |
3 | use YAML::XS; |
4 | use aliased 'MooseX::Antlers::RefTracker'; |
5 | use aliased 'MooseX::Antlers::RefFilter'; |
6 | |
7 | my $foo = { |
8 | bar => { baz => [ 'quux', { fleem => 1 } ] }, |
9 | skald => \[ { hot => 'story' } ], |
10 | }; |
11 | |
12 | my @expect = split "\n", <<'EOEXPECT'; |
13 | $foo |
14 | $foo->{"bar"} |
15 | $foo->{"skald"} |
16 | ${$foo->{"skald"}} |
17 | ${$foo->{"skald"}}->[0] |
18 | EOEXPECT |
19 | |
20 | my $tracker = RefTracker->new({ root_name => '$foo' }); |
21 | |
22 | $tracker->visit($foo); |
23 | |
24 | delete $foo->{bar}{baz}; |
25 | |
26 | my $result = $tracker->traced_ref_map; |
27 | |
28 | is_deeply( |
29 | \@expect, |
30 | [ sort { length($a) <=> length($b) } values %$result ], |
31 | "Expected results present" |
32 | ); |
33 | |
34 | my %map = reverse %$result; |
35 | |
36 | foreach my $e (@expect) { |
37 | my $value = do { |
38 | local $@; |
39 | my $r = eval $e; |
40 | die "Error $@ evaluating $e" if $@; |
41 | $r; |
42 | }; |
43 | is($map{$e},refaddr($value), "Result for ${e} ok"); |
44 | } |
45 | |
46 | my $flimflam = { |
47 | one => { two => three }, |
48 | bard => $foo->{skald}, |
49 | bard_guts => ${$foo->{skald}}, |
50 | empty_now => $foo->{bar}, |
51 | }; |
52 | |
53 | weaken($flimflam->{weak_one} = $flimflam->{one}); |
54 | weaken($flimflam->{weak_member}[0] = $flimflam->{bard}); |
55 | weaken(${$flimflam->{weak_scalar}} = $flimflam->{bard_guts}); |
56 | |
57 | #use Data::Dumper; $Data::Dumper::Indent = 1; |
58 | |
59 | #warn "Flimflam:\n".Dumper($flimflam); |
60 | |
61 | my $replacer = RefFilter->new({ |
62 | external_mappings => $result, |
63 | root_name => '$final', |
64 | }); |
65 | |
66 | my $copyflam = $replacer->visit($flimflam); |
67 | |
68 | my $dump = Dump($copyflam); |
69 | my $fixup = $replacer->fixup_code; |
70 | |
71 | #warn "Dump:\n".$dump; |
72 | #warn "Fixup:\n".$fixup; |
73 | |
74 | my $final = Load($dump); |
75 | |
76 | #warn "Unfixed final:\n".Dumper($final); |
77 | |
78 | { |
79 | local $@; |
80 | eval $fixup; |
81 | die "fixup code died: $@" if $@; |
82 | } |
83 | |
84 | #warn "Fixed final:\n".Dumper($final); |
85 | |
86 | is_deeply($flimflam, $final, 'Structures deeply the same after fixup'); |
87 | |
88 | ok(isweak($final->{weak_one}), '$final->{weak_one} is a weak ref'); |
89 | ok(isweak($final->{weak_member}[0]), '$final->{weak_member}[0] is a weak ref'); |
90 | ok(isweak(${$final->{weak_scalar}}), '${$final->{weak_scalar}} is a weak ref'); |