break tracer.pl out into multifarious manifoldly marvelous modules

[gitmo/MooseX-Antlers.git] / t / refwalk.t

diff --git a/t/refwalk.t b/t/refwalk.t
new file mode 100644 (file)
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');