Break it, Class::MOP::Method is losing its overloading somehow. Moving to 5.10 to...

diff --git a/t/lib/Three.pm b/t/lib/Three.pm
new file mode 100644 (file)
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 (file)
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 (file)
--- 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);