X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Antlers.git;a=blobdiff_plain;f=t%2Frefwalk.t;fp=t%2Frefwalk.t;h=29b4a312a56bc11e23c634b4b38c377fbc5836b2;hp=0000000000000000000000000000000000000000;hb=0373380cd9656a6a2be0e85483348a66396fb192;hpb=9831d16561549202379d782f8905b9d2f7b70cd9

diff --git a/t/refwalk.t b/t/refwalk.t
new file mode 100644
index 0000000..29b4a31
--- /dev/null
+++ b/t/refwalk.t
@@ -0,0 +1,90 @@
+use Test::More qw(no_plan);
+use Scalar::Util qw(refaddr weaken isweak);
+use YAML::XS;
+use aliased 'MooseX::Antlers::RefTracker';
+use aliased 'MooseX::Antlers::RefFilter';
+
+my $foo = {
+  bar => { baz => [ 'quux', { fleem => 1 } ] },
+  skald => \[ { hot => 'story' } ],
+};
+
+my @expect = split "\n", <<'EOEXPECT';
+$foo
+$foo->{"bar"}
+$foo->{"skald"}
+${$foo->{"skald"}}
+${$foo->{"skald"}}->[0]
+EOEXPECT
+
+my $tracker = RefTracker->new({ root_name => '$foo' });
+
+$tracker->visit($foo);
+
+delete $foo->{bar}{baz};
+
+my $result = $tracker->traced_ref_map;
+
+is_deeply(
+  \@expect,
+  [ sort { length($a) <=> length($b) } values %$result ],
+  "Expected results present"
+);
+
+my %map = reverse %$result;
+
+foreach my $e (@expect) {
+  my $value = do {
+    local $@;
+    my $r = eval $e;
+    die "Error $@ evaluating $e" if $@;
+    $r;
+  };
+  is($map{$e},refaddr($value), "Result for ${e} ok");
+}
+
+my $flimflam = {
+  one => { two => three },
+  bard => $foo->{skald},
+  bard_guts => ${$foo->{skald}},
+  empty_now => $foo->{bar},
+};
+
+weaken($flimflam->{weak_one} = $flimflam->{one});
+weaken($flimflam->{weak_member}[0] = $flimflam->{bard});
+weaken(${$flimflam->{weak_scalar}} = $flimflam->{bard_guts});
+
+#use Data::Dumper; $Data::Dumper::Indent = 1;
+
+#warn "Flimflam:\n".Dumper($flimflam);
+
+my $replacer = RefFilter->new({
+  external_mappings => $result,
+  root_name => '$final',
+});
+
+my $copyflam = $replacer->visit($flimflam);
+
+my $dump = Dump($copyflam);
+my $fixup = $replacer->fixup_code;
+
+#warn "Dump:\n".$dump;
+#warn "Fixup:\n".$fixup;
+
+my $final = Load($dump);
+
+#warn "Unfixed final:\n".Dumper($final);
+
+{
+  local $@;
+  eval $fixup;
+  die "fixup code died: $@" if $@;
+}
+
+#warn "Fixed final:\n".Dumper($final);
+
+is_deeply($flimflam, $final, 'Structures deeply the same after fixup');
+
+ok(isweak($final->{weak_one}), '$final->{weak_one} is a weak ref');
+ok(isweak($final->{weak_member}[0]), '$final->{weak_member}[0] is a weak ref');
+ok(isweak(${$final->{weak_scalar}}), '${$final->{weak_scalar}} is a weak ref');