metaclass dumping

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

use strict;
use warnings FATAL => 'all';
use MooseX::Antlers::Compiler;
use lib 't/lib';
use Test::More;
use Test::Exception;
use Class::Unload;
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 {
  &cmp_ok(One->get_called_foo, '==', @_); # cmp_ok has a $$$;$ proto
}

sub test_One {

  ok(One->can('foo'), 'foo accessor installed');

  dies_ok { One->new } 'foo is required';

  foo_called(0 => 'trigger not called yet');

  my $one = One->new(foo => 1);

  foo_called(1 => 'trigger called once (constructor)');

  cmp_ok($one->foo, '==', 1, 'read ok');

  foo_called(1 => 'trigger not called for read');

  $one->foo(2);

  foo_called(2 => 'trigger called for setter');
}

my %orig_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY foo);

One->meta->get_method_list; # fill cache

my $orig_meta = dump_meta One->meta;

test_One();

my $compiled = $compiler->compiled_source;

#warn $compiled; done_testing; exit 0;

Class::Unload->unload('One');
Class::MOP::remove_metaclass_by_name('One');

io('/tmp/One.pmc')->print($compiled);

require '/tmp/One.pmc';

#eval "no warnings; $compiled";

#die "Shit. failed.\n\n${compiled}\n\nError: $@" if $@;

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
# eval compiled source
# run test_class after that as well as before unload

#warn Dumper \%attr_refs;
#warn Dumper \%attr_et;
#warn Dumper $im_et;

done_testing;