From: Jesse Luehrs <doy@tozt.net>
Date: Wed, 9 Sep 2009 23:34:40 +0000 (-0500)
Subject: add an option to disable the mutable ancestor warning
X-Git-Tag: 0.89_02~10
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ad233fd3f0755aad844c5c24030470520a93cc19;p=gitmo%2FMoose.git

add an option to disable the mutable ancestor warning
---

diff --git a/lib/Moose/Manual/Delta.pod b/lib/Moose/Manual/Delta.pod
index 69b271a..79b8397 100644
--- a/lib/Moose/Manual/Delta.pod
+++ b/lib/Moose/Manual/Delta.pod
@@ -38,6 +38,12 @@ of its subclasses in the middle of its class definition, so pointing out that
 this may cause issues should be helpful. Metaclasses (classes that inherit
 from L<Class::MOP::Object>) are currently exempt from this check, since at the
 moment we aren't very consistent about which metaclasses we immutabilize.
+Anonymous classes are also exempt, since they are often created automatically,
+and the user is never given a choice about whether or not to make them
+immutable. If you're sure you know what you're doing, you also can pass the
+C<allow_mutable_ancestors> option to make_immutable to silence the warning
+(but be aware that modifying those mutable ancestors can still lead to
+incorrect behavior in your subclass).
 
 =back
 
diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 4ab875c..224467e 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -72,6 +72,7 @@ sub _immutable_options {
     my ( $self, @args ) = @_;
 
     $self->SUPER::_immutable_options(
+        allow_mutable_ancestors => 0,
         inline_destructor => 1,
 
         # Moose always does this when an attribute is created
@@ -142,9 +143,11 @@ sub add_role {
 
 sub make_immutable {
     my $self = shift;
+    my %args = @_;
 
     # we do this for metaclasses way too often to do this check for them
-    if ( !$self->name->isa('Class::MOP::Object') ) {
+    if ( !$args{allow_mutable_ancestors}
+      && !$self->name->isa('Class::MOP::Object') ) {
         my @superclasses = grep { $_ ne 'Moose::Object' && $_ ne $self->name }
             $self->linearized_isa;
 
@@ -731,6 +734,10 @@ enables inlining the destructor.
 Also, since Moose always inlines attributes, it sets the
 C<inline_accessors> option to false.
 
+It also accepts the additional C<allow_mutable_ancestors> option, to
+silence the warning you get when trying to make a class with mutable
+ancestors immutable.
+
 =item B<< $metaclass->new_object(%params) >>
 
 This overrides the parent's method in order to add support for
diff --git a/t/300_immutable/016_immutable_with_mutable_ancestors.t b/t/300_immutable/016_immutable_with_mutable_ancestors.t
index a36a7e9..0e10fd0 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 => 5;
+    plan tests => 6;
 }
 
 {
@@ -88,3 +88,14 @@ stderr_like {
         __PACKAGE__->meta->make_immutable
     } '', "no warning when ancestor is a base-class role subclass of Moose::Object";
 }
+
+{
+    package Foo::Sub4;
+    use Moose;
+    extends 'Foo';
+
+    ::stderr_is {
+        __PACKAGE__->meta->make_immutable(allow_mutable_ancestors => 1)
+    } '',
+      "no warning when allow_mutable_ancestors => 1 is passed";
+}