Break it, Class::MOP::Method is losing its overloading somehow. Moving to 5.10 to...

[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;

sub dump_meta {
  my $meta = $_[0];
  local $meta->{methods}{meta};
  join '', Dump($meta);
}

sub foo_called {
  &cmp_ok(shift->get_called_foo, '==', @_); # cmp_ok has a $$$;$ proto
}

sub test_One {
  my $class = shift;

  ok($class->can('foo'), $class . ' foo accessor installed');

  dies_ok { $class->new } $class . ' foo is required';

  foo_called($class, 0 => $class . ' trigger not called yet');

  my $i = $class->new(foo => 1);

  foo_called($class, 1 => $class . ' trigger called once (constructor)');

  cmp_ok($i->foo, '==', 1, $class . ' read ok');

  foo_called($class, 1 => $class . ' trigger not called for read');

  $i->foo(2);

  foo_called($class, 2 => $class . ' trigger called for setter');
}

test_class('One', \&test_One);
test_class('Two', \&test_One);
test_class('Three', \&test_One);

sub test_class {
    my ($class, $test) = @_;

    my $compiler = MooseX::Antlers::Compiler->load_with_compiler($class);

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

    $class->meta->get_method_list; # fill cache

    my $orig_meta = dump_meta $class->meta;

    $test->($class);

    my $compiled = $compiler->compiled_source;

    #warn $compiled; done_testing; exit 0;

    Class::Unload->unload($class);
    Class::MOP::remove_metaclass_by_name($class);

    io("/tmp/$class.pmc")->print($compiled);

    require "/tmp/$class.pmc";

    #eval "no warnings; $compiled";

    #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, $class . ' metaclass restored ok');

    Class::Unload->unload($class);
    Class::MOP::remove_metaclass_by_name($class);
}

done_testing;