Merge pull request #27 from gfx/issue-17

Disable metaclass cache in M::M::Role::Application to fix #17

lib/Mouse/Meta/Role/Application.pm

@@ -53,11 +53,12 @@ sub apply {
         $self->{_to} = 'instance';
         $instance  = $consumer;
 
-        $consumer = (Mouse::Util::class_of($instance) || 'Mouse::Meta::Class')
+        my $meta = Mouse::Util::class_of($instance);
+        $consumer = ($meta || 'Mouse::Meta::Class')
             ->create_anon_class(
                 superclasses => [ref $instance],
                 roles        => [$role],
-                cache        => 1,
+                cache        => 0,
 
                 in_application_to_instance => 1, # suppress to apply roles
             );

t/030_roles/010_run_time_role_composition.t

@@ -66,9 +66,10 @@ isa_ok($obj2, 'My::Class');
     Bark->meta->apply($obj2);
 
     ok($obj2->does('Bark'), '... we now do the Bark role');
+    { local $TODO = '#17';
     is(blessed($obj), blessed($obj2), '... they share the same anon-class/role thing');
+    }
 }
-
 {
     is($obj->sleep, 'nite-nite', '... the original method responds as expected');
 
@@ -97,7 +98,8 @@ isa_ok($obj2, 'My::Class');
     Sleeper->meta->apply($obj2);
 
     ok($obj2->does('Sleeper'), '... we now do the Bark role');
+    { local $TODO = '#17';
     is(blessed($obj), blessed($obj2), '... they share the same anon-class/role thing again');
+    }
 }
-
 done_testing;

t/900_mouse_bugs/016_issue17_memleak.t

@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::LeakTrace;
+
+{
+    package Iyan;
+    use Mouse;
+}
+
+{
+    package Role1;
+    use Mouse::Role;
+}
+
+{
+    package Role2;
+    use Mouse::Role;
+}
+
+no_leaks_ok {
+    foo();
+} 'apply_all_roles';
+
+note 'after no_leaks_ok';
+
+done_testing;
+
+sub foo {
+    my $self = bless {}, 'Iyan';
+    Mouse::Util::apply_all_roles($self, 'Role1', 'Role2');
+}