X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=tracer.pl;h=a170ace4f7074df7dc6ed9e2a93d7644824d9716;hb=d8576cdcd81336a292240910b7ee5c4ad4e11dc2;hp=a58c25a318fb39694fe8583cab9d8dfe8b6da385;hpb=3aa089043a81238f12264b987ec1d6e20287821a;p=gitmo%2FMooseX-Antlers.git diff --git a/tracer.pl b/tracer.pl index a58c25a..a170ace 100644 --- a/tracer.pl +++ b/tracer.pl @@ -119,7 +119,10 @@ sub visit_ref { # 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; } @@ -136,6 +139,44 @@ sub visit_ref { 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(@_) } @@ -143,7 +184,7 @@ 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 } ] }, @@ -184,25 +225,24 @@ foreach my $e (@expect) { 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;