almost all tests passing!

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 7884594..23232d2 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -690,10 +690,6 @@ 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,
@@ -703,7 +699,6 @@ $_->meta->make_immutable(
     Class::MOP::Package
     Class::MOP::Module
     Class::MOP::Class
-    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 1214e45..52cd74c 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -8,7 +8,6 @@ use Class::MOP::Instance;
 use Class::MOP::Method::Wrapped;
 use Class::MOP::Method::Accessor;
 use Class::MOP::Method::Constructor;
-use Class::MOP::Class::Immutable::Class::MOP::Class;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken';
@@ -181,6 +180,8 @@ sub _check_metaclass_compatibility {
     return if ref($self)                eq 'Class::MOP::Class'   &&
               $self->instance_metaclass eq 'Class::MOP::Instance';
 
+    return if $self->can('get_mutable_metaclass_name');
+
     my @class_list = $self->linearized_isa;
     shift @class_list; # shift off $self->name
 
@@ -1094,23 +1095,27 @@ sub _immutable_metaclass {
             $trait, 'ForMetaClass', ref($self);
     }
 
-    if ( Class::MOP::is_class_loaded($class_name) ) {
-        if ( $class_name->isa($trait) ) {
-            return $class_name;
+    return $class_name
+        if Class::MOP::is_class_loaded($class_name);
+
+    my $meta = Class::MOP::Class->create(
+        $class_name,
+        superclasses => [ ref $self ],
+    );
+
+    Class::MOP::load_class($trait);
+    for my $meth ( Class::MOP::Class->initialize($trait)->get_all_methods ) {
+        next if $meta->has_method( $meth->name );
+
+        if ( $meta->find_method_by_name( $meth->name ) ) {
+            $meta->add_around_method_modifier( $meth->name, $meth->body );
         }
         else {
-            confess
-                "$class_name is already defined but does not inherit $trait";
+            $meta->add_method( $meth->name, $meth->clone );
         }
     }
-    else {
-        my @super = ( $trait, ref($self) );
 
-        my $meta = $self->initialize($class_name);
-        $meta->superclasses(@super);
-
-        return $class_name;
-    }
+    return $class_name;
 }
 
 sub _remove_inlined_code {

diff --git a/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm b/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm
deleted file mode 100644 (file)
index 3eb7be3..0000000
--- a/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm
+++ /dev/null
@@ -1,41 +0,0 @@
-package Class::MOP::Class::Immutable::Class::MOP::Class;
-
-use strict;
-use warnings;
-
-our $VERSION   = '0.88';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
-use base qw(Class::MOP::Class::Immutable::Trait Class::MOP::Class);
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Class::MOP::Class::Immutable::Class::MOP::Class - An immutable subclass of Class::MOP::Class
-
-=head1 DESCRIPTION
-
-This is an empty class which inherits from
-L<Class::MOP::Class::Immutable::Trait> and L<Class::MOP::Class>.
-
-=head1 AUTHOR
-
-Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2009 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
-

diff --git a/lib/Class/MOP/Class/Immutable/Trait.pm b/lib/Class/MOP/Class/Immutable/Trait.pm
index fc7af69..0c8a505 100644 (file)
--- a/lib/Class/MOP/Class/Immutable/Trait.pm
+++ b/lib/Class/MOP/Class/Immutable/Trait.pm
@@ -17,59 +17,77 @@ sub get_mutable_metaclass_name { $_[0]{__immutable}{original_class} }
 
 sub immutable_options { %{ $_[0]{__immutable}{options} } }
 
-sub is_mutable   {0}
-sub is_immutable {1}
+sub is_mutable   { 0 }
+sub is_immutable { 1 }
 
 sub superclasses {
-    confess "This method is read-only" if @_ > 1;
-    $_[0]->next::method;
+    my $orig = shift;
+    my $self = shift;
+    confess "This method is read-only" if @_;
+    $self->$orig;
 }
 
 sub _immutable_cannot_call {
     Carp::confess "This method cannot be called on an immutable instance";
 }
 
-sub add_method            { shift->_immutable_cannot_call }
-sub alias_method          { shift->_immutable_cannot_call }
-sub remove_method         { shift->_immutable_cannot_call }
-sub add_attribute         { shift->_immutable_cannot_call }
-sub remove_attribute      { shift->_immutable_cannot_call }
-sub remove_package_symbol { shift->_immutable_cannot_call }
+sub add_method            { _immutable_cannot_call() }
+sub alias_method          { _immutable_cannot_call() }
+sub remove_method         { _immutable_cannot_call() }
+sub add_attribute         { _immutable_cannot_call() }
+sub remove_attribute      { _immutable_cannot_call() }
+sub remove_package_symbol { _immutable_cannot_call() }
 
 sub class_precedence_list {
-    @{ $_[0]{__immutable}{class_precedence_list}
-            ||= [ shift->next::method ] };
+    my $orig = shift;
+    my $self = shift;
+    @{ $self->{__immutable}{class_precedence_list}
+            ||= [ $self->$orig ] };
 }
 
 sub linearized_isa {
-    @{ $_[0]{__immutable}{linearized_isa} ||= [ shift->next::method ] };
+    my $orig = shift;
+    my $self = shift;
+    @{ $self->{__immutable}{linearized_isa} ||= [ $self->$orig ] };
 }
 
 sub get_all_methods {
-    @{ $_[0]{__immutable}{get_all_methods} ||= [ shift->next::method ] };
+    my $orig = shift;
+    my $self = shift;
+    @{ $self->{__immutable}{get_all_methods} ||= [ $self->$orig ] };
 }
 
 sub get_all_method_names {
-    @{ $_[0]{__immutable}{get_all_method_names} ||= [ shift->next::method ] };
+    my $orig = shift;
+    my $self = shift;
+    @{ $self->{__immutable}{get_all_method_names} ||= [ $self->$orig ] };
 }
 
 sub get_all_attributes {
-    @{ $_[0]{__immutable}{get_all_attributes} ||= [ shift->next::method ] };
+    my $orig = shift;
+    my $self = shift;
+    @{ $self->{__immutable}{get_all_attributes} ||= [ $self->$orig ] };
 }
 
 sub get_meta_instance {
-    $_[0]{__immutable}{get_meta_instance} ||= shift->next::method;
+    my $orig = shift;
+    my $self = shift;
+    $self->{__immutable}{get_meta_instance} ||= $self->$orig;
 }
 
 sub get_method_map {
-    $_[0]{__immutable}{get_method_map} ||= shift->next::method;
+    my $orig = shift;
+    my $self = shift;
+    $self->{__immutable}{get_method_map} ||= $self->$orig;
 }
 
 sub add_package_symbol {
+    my $orig = shift;
+    my $self = shift;
     confess "Cannot add package symbols to an immutable metaclass"
-        unless ( caller(1) )[3] eq 'Class::MOP::Package::get_package_symbol';
+        unless ( caller(3) )[3] eq 'Class::MOP::Package::get_package_symbol';
 
-    shift->next::method(@_);
+    $self->$orig(@_);
 }
 
 1;

diff --git a/t/070_immutable_metaclass.t b/t/070_immutable_metaclass.t
index d7b1c4d..8d57f5d 100644 (file)
--- a/t/070_immutable_metaclass.t
+++ b/t/070_immutable_metaclass.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 75;
+use Test::More tests => 73;
 use Test::Exception;
 
 use Class::MOP;
@@ -51,9 +51,7 @@ use Class::MOP;
     is( $immutable_class_name->meta, $immutable_metaclass,
         '... immutable_metaclass meta hack works' );
 
-    isa_ok( $meta, "Class::MOP::Class::Immutable::Trait" );
     isa_ok( $meta, "Class::MOP::Class" );
-
 }
 
 {