From: Dave Rolsky <autarch@urth.org>
Date: Mon, 7 Sep 2009 19:41:13 +0000 (-0500)
Subject: When warning on mutable parents in make_immutable, ignore anon classes.
X-Git-Tag: 0.89_02~20
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=664968492b18a4672678ad85993bff1d8f785357;p=gitmo%2FMoose.git

When warning on mutable parents in make_immutable, ignore anon classes.

An anon parent class almost certainly comes from appyling base class roles
with Moose::Util::MetaRole, and the fact that said parent is still mutable is
not an error.

Of course, we could be wrong sometimes, but we're better off missing a warning
than spitting out a ton of useless ones.
---

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 53497ad..7eb4d68 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -153,6 +153,10 @@ sub make_immutable {
 
             next unless $meta && $meta->isa('Moose::Meta::Class');
             next unless $meta->is_mutable;
+            # This can happen when a base class role is applied via
+            # Moose::Util::MetaRole::apply_base_class_roles. The parent is an
+            # anon class and is still mutable, but that's okay.
+            next if $meta->is_anon_class;
 
             Carp::cluck( "Calling make_immutable on "
                     . $self->name
diff --git a/t/300_immutable/016_immutable_with_mutable_ancestors.t b/t/300_immutable/016_immutable_with_mutable_ancestors.t
index b7b85cf..a36a7e9 100644
--- a/t/300_immutable/016_immutable_with_mutable_ancestors.t
+++ b/t/300_immutable/016_immutable_with_mutable_ancestors.t
@@ -10,7 +10,7 @@ use lib 't/lib';
 BEGIN {
     eval "use Test::Output;";
     plan skip_all => "Test::Output is required for this test" if $@;
-    plan tests => 4;
+    plan tests => 5;
 }
 
 {
@@ -68,3 +68,23 @@ stderr_like {
     require Recursive::Parent
 } qr/^Calling make_immutable on Recursive::Child, which has a mutable ancestor \(Recursive::Parent\)/,
   "circular dependencies via use are caught properly";
+
+{
+    package Base::Role;
+    use Moose::Role;
+
+    sub foo { 42 }
+
+    package Bar;
+    use Moose;
+    use Moose::Util::MetaRole;
+
+    Moose::Util::MetaRole::apply_base_class_roles(
+        for_class => __PACKAGE__,
+        roles     => ['Base::Role'],
+    );
+
+    ::stderr_is {
+        __PACKAGE__->meta->make_immutable
+    } '', "no warning when ancestor is a base-class role subclass of Moose::Object";
+}