t/one.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3 use MooseX::Antlers::Compiler;
   4 use lib 't/lib';
   5 use Test::More;
   6 use Test::Exception;
   7 use Class::Unload;
   8 use IO::All;
   9 use Data::Dumper::Concise;
  10 use Data::Dump::Streamer;
  11
  12 my $compiler = MooseX::Antlers::Compiler->load_with_compiler('One');
  13
  14 sub dump_meta {
  15   my $meta = $_[0];
  16   local $meta->{methods}{meta};
  17   join '', Dump($meta);
  18 }
  19
  20 sub foo_called {
  21   &cmp_ok(One->get_called_foo, '==', @_); # cmp_ok has a $$$;$ proto
  22 }
  23
  24 sub test_One {
  25
  26   ok(One->can('foo'), 'foo accessor installed');
  27
  28   dies_ok { One->new } 'foo is required';
  29
  30   foo_called(0 => 'trigger not called yet');
  31
  32   my $one = One->new(foo => 1);
  33
  34   foo_called(1 => 'trigger called once (constructor)');
  35
  36   cmp_ok($one->foo, '==', 1, 'read ok');
  37
  38   foo_called(1 => 'trigger not called for read');
  39
  40   $one->foo(2);
  41
  42   foo_called(2 => 'trigger called for setter');
  43 }
  44
  45 my %orig_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY foo);
  46
  47 One->meta->get_method_list; # fill cache
  48
  49 my $orig_meta = dump_meta One->meta;
  50
  51 test_One();
  52
  53 my $compiled = $compiler->compiled_source;
  54
  55 #warn $compiled; done_testing; exit 0;
  56
  57 Class::Unload->unload('One');
  58 Class::MOP::remove_metaclass_by_name('One');
  59
  60 io('/tmp/One.pmc')->print($compiled);
  61
  62 require '/tmp/One.pmc';
  63
  64 #eval "no warnings; $compiled";
  65
  66 #die "Shit. failed.\n\n${compiled}\n\nError: $@" if $@;
  67
  68 my %compiled_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY foo);
  69
  70 foreach my $method (qw(new DESTROY foo)) {
  71   is($compiled_src{$method}, $orig_src{$method}, "${method} restored ok");
  72 }
  73
  74 my $compiled_meta = dump_meta One->meta;
  75
  76 test_One;
  77
  78 #io('orig')->print($orig_meta);
  79 #io('comp')->print($compiled_meta);
  80
  81 is($orig_meta, $compiled_meta, 'metaclass restored ok');
  82
  83 # write test_class method that checks method including call
  84 # Class::Unload One
  85 # build compiled source
  86 # eval compiled source
  87 # run test_class after that as well as before unload
  88
  89 #warn Dumper \%attr_refs;
  90 #warn Dumper \%attr_et;
  91 #warn Dumper $im_et;
  92
  93 done_testing;