X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Antlers.git;a=blobdiff_plain;f=t%2Fone.t;fp=t%2Fone.t;h=e308c4468d52cb0388c2455f358a671c40d86a85;hp=aef210fa8d7f96c6992124dfd5e9429aa8549400;hb=5bd097e77c36517b6e983326120c5ced2c48d86b;hpb=064721e6419bd56c5b9e34a70180a6e6f57eab85 diff --git a/t/one.t b/t/one.t index aef210f..e308c44 100644 --- a/t/one.t +++ b/t/one.t @@ -1,51 +1,12 @@ use strict; use warnings FATAL => 'all'; -use aliased 'MooseX::Antlers::EvalTracker'; -use aliased 'MooseX::Antlers::RefTracker'; -use aliased 'MooseX::Antlers::RefFilter'; -use B qw(perlstring); +use MooseX::Antlers::Compiler; use lib 't/lib'; use Test::More; use Test::Exception; use Class::Unload; -use String::TT qw(tt strip); -use IO::All qw(io); - -my %attr_refs; -my %attr_et; -my $im_et; - -{ - require Moose; - my $orig_import = Moose->can('import'); - no warnings 'redefine'; - local *Moose::import = sub { - my $targ = caller; - Moose->$orig_import({ into => $targ }); - my $has = $targ->can('has'); - { - no strict 'refs'; - *{"${targ}::has"} = sub { - $attr_refs{$_[0]} = [ - map RefTracker->trace_refs( $_ => \@_ ), - '(\@_)', '$has_args{'.perlstring($_[0]).'}' - ]; - my $et = EvalTracker->new->enable; - $has->(@_); - $attr_et{$_[0]} = $et->disable; - return; - }; - } - }; - my $orig_immutable = Moose::Meta::Class->can('make_immutable'); - local *Moose::Meta::Class::make_immutable = sub { - my $et = EvalTracker->new->enable; - $orig_immutable->(@_); - $im_et = $et->disable; - return; - }; - require One; -} + +my $compiler = MooseX::Antlers::Compiler->load_with_compiler('One'); sub foo_called { &cmp_ok(One->get_called_foo, '==', @_); # cmp_ok has a $$$;$ proto @@ -80,49 +41,7 @@ test_One(); use Data::Dump::Streamer; -my $one_source_code = io($INC{'One.pm'})->all; - -#warn $attr_et{'foo'}->serialized_construction($attr_refs{'foo'}); - -#my @has = ( - -my $foo_build = $attr_et{'foo'}->serialized_construction($attr_refs{'foo'}[0]); - -my $im_build = $im_et->serialized_construction($attr_refs{'foo'}[1]); - -my $preamble = strip tt q{ - my %replay_has; - my %has_args; - BEGIN { - %replay_has = ( - foo => sub { - [% foo_build %] - } - ); - } - sub MooseX::Antlers::ImmutableHackFor::Foo::make_immutable { -[% im_build %] - } - use MooseX::Antlers::StealImport - Moose => { - -do => sub { - strict->import; - warnings->import; - }, - has => sub { - $has_args{$_[0]} = \@_; - ($replay_has{$_[0]}||die "Can't find replay for $_[0]") - ->(@_); - }, - meta => sub { 'MooseX::Antlers::ImmutableHackFor::Foo' } - }; -}; - -my $postamble = strip q{ - no MooseX::Antlers::StealImport qw(Moose); -}; - -my $compiled = join("\n", $preamble, $one_source_code, $postamble); +my $compiled = $compiler->compiled_source; #warn $compiled; done_testing; exit 0;