From: Tomas Doran Date: Tue, 12 Jan 2010 21:08:23 +0000 (+0000) Subject: Break it, Class::MOP::Method is losing its overloading somehow. Moving to 5.10 to... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8cfc65ef84dba460dab41a5324f7b2c4b2aa1af5;p=gitmo%2FMooseX-Antlers.git Break it, Class::MOP::Method is losing its overloading somehow. Moving to 5.10 to see if this is the bug we ran into in MooseX::Role::WithOverloading --- diff --git a/t/lib/Three.pm b/t/lib/Three.pm new file mode 100644 index 0000000..064449f --- /dev/null +++ b/t/lib/Three.pm @@ -0,0 +1,23 @@ +package Three; + +use Moose; + +my $called_foo = 0; + +sub get_called_foo { $called_foo } + +has foo => (is => 'rw', required => 1 ); + +sub BUILD { + my $self = shift; + $self->foo(42); +} + +#before foo => sub { +# my ($self, $val) = @_; +# $called_foo++ if $val; +#}; + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/t/lib/Two.pm b/t/lib/Two.pm new file mode 100644 index 0000000..a9cfc1d --- /dev/null +++ b/t/lib/Two.pm @@ -0,0 +1,13 @@ +package Two; # Exactly the same as One, just in a different package.. + +use Moose; + +my $called_foo = 0; + +sub get_called_foo { $called_foo } + +has foo => (is => 'rw', required => 1, trigger => sub { $called_foo++ }); + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/t/one.t b/t/one.t index 83c7f87..cf15a34 100644 --- a/t/one.t +++ b/t/one.t @@ -16,32 +16,34 @@ sub dump_meta { } sub foo_called { - &cmp_ok(One->get_called_foo, '==', @_); # cmp_ok has a $$$;$ proto + &cmp_ok(shift->get_called_foo, '==', @_); # cmp_ok has a $$$;$ proto } sub test_One { + my $class = shift; - ok(One->can('foo'), 'foo accessor installed'); + ok($class->can('foo'), $class . ' foo accessor installed'); - dies_ok { One->new } 'foo is required'; + dies_ok { $class->new } $class . ' foo is required'; - foo_called(0 => 'trigger not called yet'); + foo_called($class, 0 => $class . ' trigger not called yet'); - my $one = One->new(foo => 1); + my $i = $class->new(foo => 1); - foo_called(1 => 'trigger called once (constructor)'); + foo_called($class, 1 => $class . ' trigger called once (constructor)'); - cmp_ok($one->foo, '==', 1, 'read ok'); + cmp_ok($i->foo, '==', 1, $class . ' read ok'); - foo_called(1 => 'trigger not called for read'); + foo_called($class, 1 => $class . ' trigger not called for read'); - $one->foo(2); + $i->foo(2); - foo_called(2 => 'trigger called for setter'); + foo_called($class, 2 => $class . ' trigger called for setter'); } -my $class = 'One'; -test_class($class, \&test_One); +test_class('One', \&test_One); +test_class('Two', \&test_One); +test_class('Three', \&test_One); sub test_class { my ($class, $test) = @_; @@ -86,7 +88,7 @@ sub test_class { #io('orig')->print($orig_meta); #io('comp')->print($compiled_meta); - is($orig_meta, $compiled_meta, 'metaclass restored ok'); + is($orig_meta, $compiled_meta, $class . ' metaclass restored ok'); Class::Unload->unload($class); Class::MOP::remove_metaclass_by_name($class);