serialising roughly the right things in roughly the right order

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

diff --git a/t/track_eval.t b/t/track_eval.t
index d81fb35..20f34ef 100644 (file)
--- a/t/track_eval.t
+++ b/t/track_eval.t
@@ -1,6 +1,29 @@
 use strict;
 use warnings;
 use aliased 'MooseX::Antlers::EvalTracker';
+use aliased 'MooseX::Antlers::RefTracker';
+use aliased 'MooseX::Antlers::RefFilter';
+use Moose ();
+use B qw(perlstring);
+use Scalar::Util qw(refaddr);
+
+my @trap;
+
+{
+  my $orig = Moose::Meta::Class->can('add_attribute');
+  no warnings 'redefine';
+  *Moose::Meta::Class::add_attribute = sub {
+    my ($self, $name) = @_;
+    my $root_name = 
+      '$add_attribute{'.perlstring($self->name).'}'
+                   .'{'.perlstring($name).'}';
+    my $tracker = RefTracker->new({ root_name => $root_name });
+    $tracker->visit(\@_);
+    my $refs = $tracker->traced_ref_map;
+    push(@trap, [ $root_name, $name, $refs ]);
+    return $orig->(@_);
+  };
+}
 
 my $et = EvalTracker->new;
 
@@ -13,3 +36,48 @@ $et->enable;
 
   has 'test' => (is => 'rw', trigger => sub { warn "trigger!\n" });
 }
+
+use Data::Dumper; $Data::Dumper::Indent = 1;
+
+my $attr_root = '$meta->{attributes}{'.perlstring($trap[0][1]).'}';
+
+my $filter_attr = RefFilter->new({
+  external_mappings => $trap[0][2],
+  root_name => $attr_root,
+});
+
+$trap[0][2]{refaddr(Foo->meta)} = '$meta';
+my $cr = $et->recorded_coderefs->[0][0];
+$trap[0][2]{refaddr($cr)} = '$coderefs[0]';
+
+my $attr_object = Foo->meta->{attributes}{$trap[0][1]};
+
+my $record = $filter_attr->visit($attr_object);
+
+my $tracker = RefTracker->new({
+  root_name => $attr_root,
+});
+
+$tracker->visit($record);
+
+my $filter_captures = RefFilter->new({
+  external_mappings => {
+    %{$tracker->traced_ref_map}, %{$trap[0][2]},
+    refaddr($attr_object) => $attr_root,
+  },
+  root_name => '$captures',
+});
+
+my $captures_record = $filter_captures->visit($et->recorded_coderefs->[0][1]);
+
+warn Data::Dumper->Dump([$record],[$attr_root]);
+
+warn 'my '.Data::Dumper->Dump([$captures_record],['$captures']);
+
+warn $filter_captures->fixup_code;
+
+warn 'my @coderefs = ('."\n".$et->_generate_coderef_constructor($et->recorded_coderefs->[0])."->(\$captures)\n);\n";
+
+warn $filter_attr->fixup_code;
+
+#warn %{$trap[0]};