2 use warnings FATAL => 'all';
3 use aliased 'MooseX::Antlers::EvalTracker';
4 use aliased 'MooseX::Antlers::RefTracker';
5 use aliased 'MooseX::Antlers::RefFilter';
11 use String::TT qw(tt strip);
20 my $orig_import = Moose->can('import');
21 no warnings 'redefine';
22 local *Moose::import = sub {
24 Moose->$orig_import({ into => $targ });
25 my $has = $targ->can('has');
28 *{"${targ}::has"} = sub {
30 map RefTracker->trace_refs( $_ => \@_ ),
31 '(\@_)', '$has_args{'.perlstring($_[0]).'}'
33 my $et = EvalTracker->new->enable;
35 $attr_et{$_[0]} = $et->disable;
40 my $orig_immutable = Moose::Meta::Class->can('make_immutable');
41 local *Moose::Meta::Class::make_immutable = sub {
42 my $et = EvalTracker->new->enable;
43 $orig_immutable->(@_);
44 $im_et = $et->disable;
51 &cmp_ok(One->get_called_foo, '==', @_); # cmp_ok has a $$$;$ proto
56 ok(One->can('foo'), 'foo accessor installed');
58 dies_ok { One->new } 'foo is required';
60 foo_called(0 => 'trigger not called yet');
62 my $one = One->new(foo => 1);
64 foo_called(1 => 'trigger called once (constructor)');
66 cmp_ok($one->foo, '==', 1, 'read ok');
68 foo_called(1 => 'trigger not called for read');
72 foo_called(2 => 'trigger called for setter');
75 my %orig_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY one);
77 my $orig_foo_meta = Dump(One->meta);
81 use Data::Dump::Streamer;
83 my $one_source_code = io($INC{'One.pm'})->all;
85 #warn $attr_et{'foo'}->serialized_construction($attr_refs{'foo'});
89 my $foo_build = $attr_et{'foo'}->serialized_construction($attr_refs{'foo'}[0]);
91 my $im_build = $im_et->serialized_construction($attr_refs{'foo'}[1]);
93 my $preamble = strip tt q{
103 sub MooseX::Antlers::ImmutableHackFor::Foo::make_immutable {
106 use MooseX::Antlers::StealImport
113 $has_args{$_[0]} = \@_;
114 ($replay_has{$_[0]}||die "Can't find replay for $_[0]")
117 meta => sub { 'MooseX::Antlers::ImmutableHackFor::Foo' }
121 my $postamble = strip q{
122 no MooseX::Antlers::StealImport qw(Moose);
125 my $compiled = join("\n", $preamble, $one_source_code, $postamble);
127 #warn $compiled; done_testing; exit 0;
129 Class::Unload->unload('One');
130 Class::MOP::remove_metaclass_by_name('One');
132 eval $compiled; die "Shit. failed.\n\n${compiled}\n\nError: $@" if $@;
134 use Data::Dumper::Concise;
136 my %compiled_src = map +($_ => join '', Dump(One->can($_))), qw(new DESTROY one);
138 #foreach my $method (qw(new DESTROY one)) {
139 # is($compiled_src{$method}, $orig_src{$method}, "${method} restored ok");
144 # write test_class method that checks method including call
146 # build compiled source
147 # eval compiled source
148 # run test_class after that as well as before unload
150 #warn Dumper \%attr_refs;
151 #warn Dumper \%attr_et;