# have to test $_[0] directly since copying a weak ref gives a strong ref
+warn $self->_current_trace_name;
+warn $_[0];
if (isweak $_[0]) {
+warn "got here";
$self->weaken_these->{$self->_current_trace_name} = 1;
}
return $self->next::method(@_);
}
+sub _register_mapping { $_[2] }
+
+sub fixup_code {
+ my $self = shift;
+ join("\n\n",
+ grep defined,
+ map $self->${\"_fixup_code_for_$_"},
+ qw(externals weakrefs)
+ );
+}
+
+sub _fixup_code_for_externals {
+ my $self = shift;
+ my $ext = $self->map_these;
+ return unless keys %$ext;
+ join("\n",
+ qq{# fixup code for external references},
+ map {
+ $_.' = '.$ext->{$_}.';';
+ }
+ sort keys %$ext
+ );
+}
+
+sub _fixup_code_for_weakrefs {
+ my $self = shift;
+ my $weaken = $self->weaken_these;
+ return unless keys %$weaken;
+ join("\n",
+ qq{# fixup code for weak references},
+ 'use Scalar::Util ();',
+ map {
+ 'Scalar::Util::weaken('.$_.');';
+ }
+ sort keys %$weaken
+ );
+}
+
# force recursion into objects (Data::Visitor doesn't by default)
sub visit_object { shift->visit_ref(@_) }
}
use Test::More qw(no_plan);
-use Scalar::Util qw(refaddr);
+use Scalar::Util qw(refaddr weaken);
my $foo = {
bar => { baz => [ 'quux', { fleem => 1 } ] },
is($map{$e},refaddr($value), "Result for ${e} ok");
}
-=pod
-
-use Data::Dumper; $Data::Dumper::Indent = 1;
+my $flimflam = {
+ one => { two => three },
+ bard => $foo->{skald},
+ bard_guts => ${$foo->{skald}},
+ empty_now => $foo->{bar},
+};
-warn Dumper($tracer->_traced_refs);
-warn Dumper($tracer->_traced_names);
+weaken($flimflam->{weak_one} = $flimflam->{one});
-=pod
+my $replacer = Ref::Replacer->new({
+ external_mappings => $result,
+ root_name => '$final',
+});
-cmp_ok(
- scalar(@expect), '==', scalar(@{$tracer->_traced_refs}),
- 'Right number of traced refs',
-);
+my $copyflam = $replacer->visit($flimflam);
+
+use Data::Dumper; $Data::Dumper::Indent = 1;
-my $reflist = $tracer->_traced_refs;
+warn Dumper($copyflam);
-foreach my $i (0 .. $#expect) {
- my $tail = "at list pos $i";
- is($e[$i], $reflist[$i], "Correct ref $e[$i] at $tail");
- my $data = getdata $reflist[$i], Trace::Constants::TRACE_WIZ;
- is($data->[0], 'Blue', "tag ok at $tail");
- cmp_ok($data->[1], '==', $i, "Index ok at $i");
+warn $replacer->fixup_code;