Refactor testing code a class before and after it's regenerated into a function

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

diff --git a/t/one.t b/t/one.t
index aef210f..83c7f87 100644 (file)
--- a/t/one.t
+++ b/t/one.t
@@ -1,50 +1,18 @@
 use strict;
 use warnings FATAL => 'all';
-use aliased 'MooseX::Antlers::EvalTracker';
-use aliased 'MooseX::Antlers::RefTracker';
-use aliased 'MooseX::Antlers::RefFilter';
-use B qw(perlstring);
+use MooseX::Antlers::Compiler;
 use lib 't/lib';
 use Test::More;
 use Test::Exception;
 use Class::Unload;
-use String::TT qw(tt strip);
-use IO::All qw(io);
-
-my %attr_refs;
-my %attr_et;
-my $im_et;
-
-{
-  require Moose;
-  my $orig_import = Moose->can('import');
-  no warnings 'redefine';
-  local *Moose::import = sub {
-    my $targ = caller;
-    Moose->$orig_import({ into => $targ });
-    my $has = $targ->can('has');
-    {
-      no strict 'refs';
-      *{"${targ}::has"} = sub {
-        $attr_refs{$_[0]} = [
-          map RefTracker->trace_refs( $_ => \@_ ),
-            '(\@_)', '$has_args{'.perlstring($_[0]).'}'
-        ];
-        my $et = EvalTracker->new->enable;
-        $has->(@_);
-        $attr_et{$_[0]} = $et->disable;
-        return;
-      };
-    }
-  };
-  my $orig_immutable = Moose::Meta::Class->can('make_immutable');
-  local *Moose::Meta::Class::make_immutable = sub {
-    my $et = EvalTracker->new->enable;
-    $orig_immutable->(@_);
-    $im_et = $et->disable;
-    return;
-  };
-  require One;
+use IO::All;
+use Data::Dumper::Concise;
+use Data::Dump::Streamer;
+
+sub dump_meta {
+  my $meta = $_[0];
+  local $meta->{methods}{meta};
+  join '', Dump($meta);
 }
 
 sub foo_called {
@@ -72,83 +40,56 @@ sub test_One {
   foo_called(2 => 'trigger called for setter');
 }
 
-my %orig_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY one);
+my $class = 'One';
+test_class($class, \&test_One);
 
-my $orig_foo_meta = Dump(One->meta);
+sub test_class {
+    my ($class, $test) = @_;
 
-test_One();
+    my $compiler = MooseX::Antlers::Compiler->load_with_compiler($class);
 
-use Data::Dump::Streamer;
+    # FIXME - foo
+    my %orig_src = map +($_ => join '', Dump($class->can($_))), qw(new DESTROY foo);
 
-my $one_source_code = io($INC{'One.pm'})->all;
-
-#warn $attr_et{'foo'}->serialized_construction($attr_refs{'foo'});
-
-#my @has = (
-
-my $foo_build = $attr_et{'foo'}->serialized_construction($attr_refs{'foo'}[0]);
-
-my $im_build = $im_et->serialized_construction($attr_refs{'foo'}[1]);
-
-my $preamble = strip tt q{
-  my %replay_has;
-  my %has_args;
-  BEGIN {
-    %replay_has = (
-      foo => sub {
-        [% foo_build %]
-      }
-    );
-  }
-  sub MooseX::Antlers::ImmutableHackFor::Foo::make_immutable {
-[% im_build %]
-  }
-  use MooseX::Antlers::StealImport
-    Moose => {
-      -do => sub {
-        strict->import;
-        warnings->import;
-      },
-      has => sub {
-        $has_args{$_[0]} = \@_;
-        ($replay_has{$_[0]}||die "Can't find replay for $_[0]")
-          ->(@_);
-      },
-      meta => sub { 'MooseX::Antlers::ImmutableHackFor::Foo' }
-    };
-};
-
-my $postamble = strip q{
-  no MooseX::Antlers::StealImport qw(Moose);
-};
-
-my $compiled = join("\n", $preamble, $one_source_code, $postamble);
-
-#warn $compiled; done_testing; exit 0;
-
-Class::Unload->unload('One');
-Class::MOP::remove_metaclass_by_name('One');
-
-eval $compiled; die "Shit. failed.\n\n${compiled}\n\nError: $@" if $@;
+    $class->meta->get_method_list; # fill cache
 
-use Data::Dumper::Concise;
+    my $orig_meta = dump_meta $class->meta;
+
+    $test->($class);
+
+    my $compiled = $compiler->compiled_source;
+
+    #warn $compiled; done_testing; exit 0;
 
-my %compiled_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY one);
+    Class::Unload->unload($class);
+    Class::MOP::remove_metaclass_by_name($class);
 
-#foreach my $method (qw(new DESTROY one)) {
-#  is($compiled_src{$method}, $orig_src{$method}, "${method} restored ok");
-#}
+    io("/tmp/$class.pmc")->print($compiled);
 
-test_One;
+    require "/tmp/$class.pmc";
 
-# write test_class method that checks method including call
-# Class::Unload One
-# build compiled source
-# eval compiled source
-# run test_class after that as well as before unload
+    #eval "no warnings; $compiled";
 
-#warn Dumper \%attr_refs;
-#warn Dumper \%attr_et;
-#warn Dumper $im_et;
+    #die "Shit. failed.\n\n${compiled}\n\nError: $@" if $@;
+
+    my %compiled_src = map +($_ => join '', Dump($class->can($_))), qw(new DESTROY foo);
+
+    # FIXME - foo
+    foreach my $method (qw(new DESTROY foo)) {
+        is($compiled_src{$method}, $orig_src{$method}, "${method} restored ok");
+    }
+
+    my $compiled_meta = dump_meta $class->meta;
+
+    $test->($class);
+
+    #io('orig')->print($orig_meta);
+    #io('comp')->print($compiled_meta);
+
+    is($orig_meta, $compiled_meta, 'metaclass restored ok');
+
+    Class::Unload->unload($class);
+    Class::MOP::remove_metaclass_by_name($class);
+}
 
 done_testing;