allow safe overriding of immutable_trait

Generates a class name that involves a prefix, the metaclass name and
the trait name when overidden.

when the default immutable_trait is used (99.99999% of the cases ;-) the
name is shorter and omits the immutable trait

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 6597463..27cab70 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -672,6 +672,10 @@ undef Class::MOP::Instance->meta->{_package_cache_flag};
 # NOTE: we don't need to inline the the accessors this only lengthens
 # the compile time of the MOP, and gives us no actual benefits.
 
+# this is just nitpicking to ensure Class::MOP::Class->meta == ->meta->meta
+Class::MOP::Class->meta->immutable_metaclass;
+$Class::MOP::Class::immutable_metaclass_cache{"Class::MOP::Class"}{"Class::MOP::Class::Immutable::Trait"} = Class::MOP::Class::Immutable::Class::MOP::Class->meta;
+
 $_->meta->make_immutable(
     inline_constructor  => 1,
     replace_constructor => 1,
@@ -682,6 +686,7 @@ $_->meta->make_immutable(
     Class::MOP::Module
     Class::MOP::Class
     Class::MOP::Class::Immutable::Trait
+    Class::MOP::Class::Immutable::Class::MOP::Class
 
     Class::MOP::Attribute
     Class::MOP::Method

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index b560beb..0e0195c 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -8,7 +8,7 @@ use Class::MOP::Instance;
 use Class::MOP::Method::Wrapped;
 use Class::MOP::Method::Accessor;
 use Class::MOP::Method::Constructor;
-use Class::MOP::Class::Immutable;
+use Class::MOP::Class::Immutable::Class::MOP::Class;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken';
@@ -328,7 +328,7 @@ sub attribute_metaclass      { $_[0]->{'attribute_metaclass'}         }
 sub method_metaclass         { $_[0]->{'method_metaclass'}            }
 sub wrapped_method_metaclass { $_[0]->{'wrapped_method_metaclass'}    }
 sub instance_metaclass       { $_[0]->{'instance_metaclass'}          }
-sub immutable_trait      { $_[0]->{'immutable_trait'}         }
+sub immutable_trait          { $_[0]->{'immutable_trait'}             }
 sub constructor_class        { $_[0]->{'constructor_class'}           }
 sub constructor_name         { $_[0]->{'constructor_name'}            }
 sub destructor_class         { $_[0]->{'destructor_class'}            }
@@ -1027,18 +1027,33 @@ sub immutable_metaclass {
     my $trait = $args{immutable_trait} = $self->immutable_trait
         || confess "no immutable trait specified for $self";
 
-    my $class = "Class::MOP::Class::Immutable::" . ref($self);
+    my $meta_attr = $self->meta->find_attribute_by_name("immutable_trait");
 
-    if ( Class::MOP::is_class_loaded($class) ) {
-        return $class;
+    my $class_name;
+
+    if ( $meta_attr and $trait eq $meta_attr->default ) {
+        # if the trait is the same as the default we try and pick a predictable
+        # name for the immutable metaclass
+        $class_name = "Class::MOP::Class::Immutable::" . ref($self);
     } else {
-        my $meta = Class::MOP::Class->initialize($class);
+        $class_name = join("::", "Class::MOP::Class::Immutable::CustomTrait", $trait, "ForMetaClass", ref($self));
+    }
 
-        $meta->superclasses( $trait, ref($self) );
+    if ( Class::MOP::is_class_loaded($class_name) ) {
+        if ( $class_name->isa($trait) ) {
+            return $class_name;
+        } else {
+            confess "$class_name is already defined but does not inherit $trait";
+        }
+    } else {
+        my @super = ( $trait, ref($self) );
+
+        my $meta = Class::MOP::Class->initialize($class_name);
+        $meta->superclasses(@super);
 
         $meta->make_immutable;
 
-        return $class;
+        return $class_name;
     }
 }
 

diff --git a/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm b/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm
new file mode 100644 (file)
index 0000000..95907ca
--- /dev/null
+++ b/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm
@@ -0,0 +1,8 @@
+package Class::MOP::Class::Immutable::Class::MOP::Class;
+
+use strict;
+use warnings;
+
+use base qw(Class::MOP::Class::Immutable::Trait Class::MOP::Class);
+
+1;

diff --git a/t/000_load.t b/t/000_load.t
index 6e82101..682f17c 100644 (file)
--- a/t/000_load.t
+++ b/t/000_load.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 49;
+use Test::More tests => 50;
 
 BEGIN {
     use_ok('Class::MOP');
@@ -107,6 +107,11 @@ is(
 );
 
 is(
+    Class::MOP::Class->meta->meta, Class::MOP::Class->meta->meta->meta,
+    '... Class::MOP::Class->meta->meta == Class::MOP::Class->meta->meta->meta'
+);
+
+is(
     Class::MOP::Class->meta, Class::MOP::Class->meta->meta->meta,
     '... Class::MOP::Class->meta == Class::MOP::Class->meta->meta->meta'
 );