Commit | Line | Data |
a39b801f |
1 | use strict; |
2 | use warnings FATAL => 'all'; |
5bd097e7 |
3 | use MooseX::Antlers::Compiler; |
a39b801f |
4 | use lib 't/lib'; |
5 | use Test::More; |
064721e6 |
6 | use Test::Exception; |
7 | use Class::Unload; |
3691d03f |
8 | use IO::All; |
9 | use Data::Dumper::Concise; |
10 | use Data::Dump::Streamer; |
5bd097e7 |
11 | |
12 | my $compiler = MooseX::Antlers::Compiler->load_with_compiler('One'); |
a39b801f |
13 | |
3691d03f |
14 | sub dump_meta { |
15 | my $meta = $_[0]; |
16 | local $meta->{methods}{meta}; |
17 | join '', Dump($meta); |
18 | } |
19 | |
064721e6 |
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 | |
de39aa89 |
45 | my %orig_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY foo); |
064721e6 |
46 | |
3691d03f |
47 | One->meta->get_method_list; # fill cache |
064721e6 |
48 | |
3691d03f |
49 | my $orig_meta = dump_meta One->meta; |
a39b801f |
50 | |
3691d03f |
51 | test_One(); |
a39b801f |
52 | |
5bd097e7 |
53 | my $compiled = $compiler->compiled_source; |
064721e6 |
54 | |
55 | #warn $compiled; done_testing; exit 0; |
56 | |
57 | Class::Unload->unload('One'); |
58 | Class::MOP::remove_metaclass_by_name('One'); |
59 | |
3691d03f |
60 | io('/tmp/One.pmc')->print($compiled); |
de39aa89 |
61 | |
3691d03f |
62 | require '/tmp/One.pmc'; |
064721e6 |
63 | |
3691d03f |
64 | #eval "no warnings; $compiled"; |
65 | |
66 | #die "Shit. failed.\n\n${compiled}\n\nError: $@" if $@; |
064721e6 |
67 | |
de39aa89 |
68 | my %compiled_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY foo); |
064721e6 |
69 | |
de39aa89 |
70 | foreach my $method (qw(new DESTROY foo)) { |
71 | is($compiled_src{$method}, $orig_src{$method}, "${method} restored ok"); |
72 | } |
064721e6 |
73 | |
3691d03f |
74 | my $compiled_meta = dump_meta One->meta; |
75 | |
064721e6 |
76 | test_One; |
a39b801f |
77 | |
3691d03f |
78 | #io('orig')->print($orig_meta); |
79 | #io('comp')->print($compiled_meta); |
80 | |
81 | is($orig_meta, $compiled_meta, 'metaclass restored ok'); |
82 | |
a39b801f |
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 | |
a39b801f |
89 | #warn Dumper \%attr_refs; |
064721e6 |
90 | #warn Dumper \%attr_et; |
91 | #warn Dumper $im_et; |
a39b801f |
92 | |
93 | done_testing; |