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;
+
+my $compiler = MooseX::Antlers::Compiler->load_with_compiler('One');
+
+sub dump_meta {
+ my $meta = $_[0];
+ local $meta->{methods}{meta};
+ join '', Dump($meta);
}
sub foo_called {
foo_called(2 => 'trigger called for setter');
}
-my %orig_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY one);
+my %orig_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY foo);
-my $orig_foo_meta = Dump(One->meta);
+One->meta->get_method_list; # fill cache
-test_One();
+my $orig_meta = dump_meta One->meta;
-use Data::Dump::Streamer;
+test_One();
-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);
+my $compiled = $compiler->compiled_source;
#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 $@;
+io('/tmp/One.pmc')->print($compiled);
-use Data::Dumper::Concise;
+require '/tmp/One.pmc';
+
+#eval "no warnings; $compiled";
-my %compiled_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY one);
+#die "Shit. failed.\n\n${compiled}\n\nError: $@" if $@;
-#foreach my $method (qw(new DESTROY one)) {
-# is($compiled_src{$method}, $orig_src{$method}, "${method} restored ok");
-#}
+my %compiled_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY foo);
+
+foreach my $method (qw(new DESTROY foo)) {
+ is($compiled_src{$method}, $orig_src{$method}, "${method} restored ok");
+}
+
+my $compiled_meta = dump_meta One->meta;
test_One;
+#io('orig')->print($orig_meta);
+#io('comp')->print($compiled_meta);
+
+is($orig_meta, $compiled_meta, 'metaclass restored ok');
+
# write test_class method that checks method including call
# Class::Unload One
# build compiled source