t/refwalk.t

   1 use Test::More;
   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');
  91
  92 done_testing;