added ability to reverse immutability, sorry about the whitespace issue.. i accidenta...
Guillermo Roditi [Fri, 1 Jun 2007 22:30:32 +0000 (22:30 +0000)]
Changes
lib/Class/MOP/Class.pm
lib/Class/MOP/Immutable.pm
t/010_self_introspection.t
t/070_immutable_metaclass.t
t/073_make_mutable.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 0d4da96..917c69d 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,4 +1,12 @@
 Revision history for Perl extension Class-MOP.
+0.39 
+    * Class::MOP::Class::Immutable
+      - added make_metaclass_mutable + docs (groditi)
+      - removed unused variable
+
+    * Class::MOP::Class
+      - Immutability can now be undone,
+        added make_mutable + tests + docs (groditi)
 
 0.38 Thurs. May 31, 2007
     ~~ More documentation updates ~~
index db0f538..cbfa745 100644 (file)
@@ -18,17 +18,17 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Module';
 
-# Self-introspection 
+# Self-introspection
 
 sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
 
 # Creation
-    
+
 sub initialize {
     my $class        = shift;
     my $package_name = shift;
     (defined $package_name && $package_name && !blessed($package_name))
-        || confess "You must pass a package name and it cannot be blessed";    
+        || confess "You must pass a package name and it cannot be blessed";
     $class->construct_class_instance('package' => $package_name, @_);
 }
 
@@ -36,34 +36,34 @@ sub reinitialize {
     my $class        = shift;
     my $package_name = shift;
     (defined $package_name && $package_name && !blessed($package_name))
-        || confess "You must pass a package name and it cannot be blessed";    
+        || confess "You must pass a package name and it cannot be blessed";
     Class::MOP::remove_metaclass_by_name($package_name);
     $class->construct_class_instance('package' => $package_name, @_);
-}       
-    
-# NOTE: (meta-circularity) 
-# this is a special form of &construct_instance 
+}
+
+# NOTE: (meta-circularity)
+# this is a special form of &construct_instance
 # (see below), which is used to construct class
-# meta-object instances for any Class::MOP::* 
-# class. All other classes will use the more 
+# meta-object instances for any Class::MOP::*
+# class. All other classes will use the more
 # normal &construct_instance.
 sub construct_class_instance {
     my $class        = shift;
     my %options      = @_;
     my $package_name = $options{'package'};
     (defined $package_name && $package_name)
-        || confess "You must pass a package name";  
+        || confess "You must pass a package name";
     # NOTE:
-    # return the metaclass if we have it cached, 
-    # and it is still defined (it has not been 
-    # reaped by DESTROY yet, which can happen 
+    # return the metaclass if we have it cached,
+    # and it is still defined (it has not been
+    # reaped by DESTROY yet, which can happen
     # annoyingly enough during global destruction)
     return Class::MOP::get_metaclass_by_name($package_name)
-        if Class::MOP::does_metaclass_exist($package_name);  
+        if Class::MOP::does_metaclass_exist($package_name);
 
     # NOTE:
-    # we need to deal with the possibility 
-    # of class immutability here, and then 
+    # we need to deal with the possibility
+    # of class immutability here, and then
     # get the name of the class appropriately
     $class = (blessed($class)
                     ? ($class->is_immutable
@@ -74,28 +74,28 @@ sub construct_class_instance {
     # now create the metaclass
     my $meta;
     if ($class =~ /^Class::MOP::Class$/) {
-        no strict 'refs';                
-        $meta = bless { 
+        no strict 'refs';
+        $meta = bless {
             # inherited from Class::MOP::Package
-            '$!package'             => $package_name, 
-            
+            '$!package'             => $package_name,
+
             # NOTE:
-            # since the following attributes will 
-            # actually be loaded from the symbol 
+            # since the following attributes will
+            # actually be loaded from the symbol
             # table, and actually bypass the instance
             # entirely, we can just leave these things
             # listed here for reference, because they
-            # should not actually have a value associated 
+            # should not actually have a value associated
             # with the slot.
-            '%!namespace'           => \undef,                
+            '%!namespace'           => \undef,
             # inherited from Class::MOP::Module
             '$!version'             => \undef,
             '$!authority'           => \undef,
             # defined in Class::MOP::Class
             '@!superclasses'        => \undef,
-            
+
             '%!methods'             => {},
-            '%!attributes'          => {},            
+            '%!attributes'          => {},
             '$!attribute_metaclass' => $options{'attribute_metaclass'} || 'Class::MOP::Attribute',
             '$!method_metaclass'    => $options{'method_metaclass'}    || 'Class::MOP::Method',
             '$!instance_metaclass'  => $options{'instance_metaclass'}  || 'Class::MOP::Instance',
@@ -104,103 +104,103 @@ sub construct_class_instance {
     else {
         # NOTE:
         # it is safe to use meta here because
-        # class will always be a subclass of 
+        # class will always be a subclass of
         # Class::MOP::Class, which defines meta
         $meta = $class->meta->construct_instance(%options)
     }
-    
+
     # and check the metaclass compatibility
     $meta->check_metaclass_compatability();
-    
+
     Class::MOP::store_metaclass_by_name($package_name, $meta);
-    
+
     # NOTE:
     # we need to weaken any anon classes
     # so that they can call DESTROY properly
     Class::MOP::weaken_metaclass($package_name) if $meta->is_anon_class;
-    
-    $meta;        
-} 
-    
+
+    $meta;
+}
+
 sub check_metaclass_compatability {
     my $self = shift;
 
     # this is always okay ...
-    return if blessed($self)            eq 'Class::MOP::Class'   && 
+    return if blessed($self)            eq 'Class::MOP::Class'   &&
               $self->instance_metaclass eq 'Class::MOP::Instance';
 
     my @class_list = $self->class_precedence_list;
     shift @class_list; # shift off $self->name
 
-    foreach my $class_name (@class_list) { 
+    foreach my $class_name (@class_list) {
         my $meta = Class::MOP::get_metaclass_by_name($class_name) || next;
-        
+
         # NOTE:
-        # we need to deal with the possibility 
-        # of class immutability here, and then 
-        # get the name of the class appropriately            
+        # we need to deal with the possibility
+        # of class immutability here, and then
+        # get the name of the class appropriately
         my $meta_type = ($meta->is_immutable
                             ? $meta->get_mutable_metaclass_name()
-                            : blessed($meta));                
-                            
+                            : blessed($meta));
+
         ($self->isa($meta_type))
-            || confess $self->name . "->meta => (" . (blessed($self)) . ")" . 
-                       " is not compatible with the " . 
+            || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
+                       " is not compatible with the " .
                        $class_name . "->meta => (" . ($meta_type)     . ")";
         # NOTE:
         # we also need to check that instance metaclasses
         # are compatabile in the same the class.
         ($self->instance_metaclass->isa($meta->instance_metaclass))
-            || confess $self->name . "->meta => (" . ($self->instance_metaclass) . ")" . 
-                       " is not compatible with the " . 
-                       $class_name . "->meta => (" . ($meta->instance_metaclass) . ")";                           
-    }        
-} 
+            || confess $self->name . "->meta => (" . ($self->instance_metaclass) . ")" .
+                       " is not compatible with the " .
+                       $class_name . "->meta => (" . ($meta->instance_metaclass) . ")";
+    }
+}
 
 ## ANON classes
 
 {
     # NOTE:
-    # this should be sufficient, if you have a 
-    # use case where it is not, write a test and 
+    # this should be sufficient, if you have a
+    # use case where it is not, write a test and
     # I will change it.
     my $ANON_CLASS_SERIAL = 0;
-    
+
     # NOTE:
     # we need a sufficiently annoying prefix
-    # this should suffice for now, this is 
-    # used in a couple of places below, so 
+    # this should suffice for now, this is
+    # used in a couple of places below, so
     # need to put it up here for now.
-    my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';    
+    my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
 
     sub is_anon_class {
         my $self = shift;
         no warnings 'uninitialized';
-        $self->name =~ /^$ANON_CLASS_PREFIX/ ? 1 : 0;        
+        $self->name =~ /^$ANON_CLASS_PREFIX/ ? 1 : 0;
     }
 
     sub create_anon_class {
-        my ($class, %options) = @_;   
+        my ($class, %options) = @_;
         my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
         return $class->create($package_name, %options);
-    } 
+    }
 
     # NOTE:
-    # this will only get called for 
-    # anon-classes, all other calls 
-    # are assumed to occur during 
+    # this will only get called for
+    # anon-classes, all other calls
+    # are assumed to occur during
     # global destruction and so don't
     # really need to be handled explicitly
     sub DESTROY {
         my $self = shift;
-        no warnings 'uninitialized';        
+        no warnings 'uninitialized';
         return unless $self->name =~ /^$ANON_CLASS_PREFIX/;
         my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/);
-        no strict 'refs';     
+        no strict 'refs';
         foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) {
             delete ${$ANON_CLASS_PREFIX . $serial_id}{$key};
         }
-        delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'};        
+        delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'};
     }
 
 }
@@ -210,35 +210,35 @@ sub check_metaclass_compatability {
 sub create {
     my $class        = shift;
     my $package_name = shift;
-    
+
     (defined $package_name && $package_name)
         || confess "You must pass a package name";
 
     (scalar @_ % 2 == 0)
-        || confess "You much pass all parameters as name => value pairs " . 
+        || confess "You much pass all parameters as name => value pairs " .
                    "(I found an uneven number of params in \@_)";
 
     my (%options) = @_;
-    
+
     my $code = "package $package_name;";
-    $code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';" 
+    $code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';"
         if exists $options{version};
-    $code .= "\$$package_name\:\:AUTHORITY = '" . $options{authority} . "';" 
-        if exists $options{authority};  
-              
+    $code .= "\$$package_name\:\:AUTHORITY = '" . $options{authority} . "';"
+        if exists $options{authority};
+
     eval $code;
-    confess "creation of $package_name failed : $@" if $@;    
-    
+    confess "creation of $package_name failed : $@" if $@;
+
     my $meta = $class->initialize($package_name);
-    
-    $meta->add_method('meta' => sub { 
+
+    $meta->add_method('meta' => sub {
         $class->initialize(blessed($_[0]) || $_[0]);
     });
-    
+
     $meta->superclasses(@{$options{superclasses}})
         if exists $options{superclasses};
     # NOTE:
-    # process attributes first, so that they can 
+    # process attributes first, so that they can
     # install accessors, but locally defined methods
     # can then overwrite them. It is maybe a little odd, but
     # I think this should be the order of things.
@@ -246,19 +246,19 @@ sub create {
         foreach my $attr (@{$options{attributes}}) {
             $meta->add_attribute($attr);
         }
-    }        
+    }
     if (exists $options{methods}) {
         foreach my $method_name (keys %{$options{methods}}) {
             $meta->add_method($method_name, $options{methods}->{$method_name});
         }
-    }  
+    }
     return $meta;
 }
 
 ## Attribute readers
 
 # NOTE:
-# all these attribute readers will be bootstrapped 
+# all these attribute readers will be bootstrapped
 # away in the Class::MOP bootstrap section
 
 sub get_attribute_map   { $_[0]->{'%!attributes'}          }
@@ -268,27 +268,27 @@ sub instance_metaclass  { $_[0]->{'$!instance_metaclass'}  }
 
 # FIXME:
 # this is a prime canidate for conversion to XS
-sub get_method_map {    
+sub get_method_map {
     my $self = shift;
-    my $map  = $self->{'%!methods'}; 
-    
+    my $map  = $self->{'%!methods'};
+
     my $class_name       = $self->name;
     my $method_metaclass = $self->method_metaclass;
-    
+
     foreach my $symbol ($self->list_all_package_symbols('CODE')) {
         my $code = $self->get_package_symbol('&' . $symbol);
-        
-        next if exists  $map->{$symbol} && 
-                defined $map->{$symbol} && 
-                        $map->{$symbol}->body == $code;        
-        
+
+        next if exists  $map->{$symbol} &&
+                defined $map->{$symbol} &&
+                        $map->{$symbol}->body == $code;
+
         my $gv = svref_2object($code)->GV;
         next if ($gv->STASH->NAME || '') ne $class_name &&
-                ($gv->NAME        || '') ne '__ANON__';        
-        
+                ($gv->NAME        || '') ne '__ANON__';
+
         $map->{$symbol} = $method_metaclass->wrap($code);
     }
-    
+
     return $map;
 }
 
@@ -297,7 +297,7 @@ sub get_method_map {
 sub new_object {
     my $class = shift;
     # NOTE:
-    # we need to protect the integrity of the 
+    # we need to protect the integrity of the
     # Class::MOP::Class singletons here, so we
     # delegate this to &construct_class_instance
     # which will deal with the singletons
@@ -313,14 +313,14 @@ sub construct_instance {
     foreach my $attr ($class->compute_all_applicable_attributes()) {
         $attr->initialize_instance_slot($meta_instance, $instance, \%params);
     }
-    # NOTE: 
+    # NOTE:
     # this will only work for a HASH instance type
     if ($class->is_anon_class) {
         (reftype($instance) eq 'HASH')
             || confess "Currently only HASH based instances are supported with instance of anon-classes";
         # NOTE:
         # At some point we should make this official
-        # as a reserved slot name, but right now I am 
+        # as a reserved slot name, but right now I am
         # going to keep it here.
         # my $RESERVED_MOP_SLOT = '__MOP__';
         $instance->{'__MOP__'} = $class;
@@ -331,21 +331,21 @@ sub construct_instance {
 sub get_meta_instance {
     my $class = shift;
     return $class->instance_metaclass->new(
-        $class, 
+        $class,
         $class->compute_all_applicable_attributes()
     );
 }
 
 sub clone_object {
     my $class    = shift;
-    my $instance = shift; 
+    my $instance = shift;
     (blessed($instance) && $instance->isa($class->name))
         || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
     # NOTE:
-    # we need to protect the integrity of the 
-    # Class::MOP::Class singletons here, they 
+    # we need to protect the integrity of the
+    # Class::MOP::Class singletons here, they
     # should not be cloned.
-    return $instance if $instance->isa('Class::MOP::Class');   
+    return $instance if $instance->isa('Class::MOP::Class');
     $class->clone_instance($instance, @_);
 }
 
@@ -354,13 +354,13 @@ sub clone_instance {
     (blessed($instance))
         || confess "You can only clone instances, \$self is not a blessed instance";
     my $meta_instance = $class->get_meta_instance();
-    my $clone = $meta_instance->clone_instance($instance);     
+    my $clone = $meta_instance->clone_instance($instance);
     foreach my $attr ($class->compute_all_applicable_attributes()) {
         if (exists $params{$attr->init_arg}) {
-            $meta_instance->set_slot_value($clone, $attr->name, $params{$attr->init_arg});                    
+            $meta_instance->set_slot_value($clone, $attr->name, $params{$attr->init_arg});
         }
-    }       
-    return $clone;    
+    }
+    return $clone;
 }
 
 # Inheritance
@@ -371,10 +371,10 @@ sub superclasses {
         my @supers = @_;
         @{$self->get_package_symbol('@ISA')} = @supers;
         # NOTE:
-        # we need to check the metaclass 
-        # compatability here so that we can 
-        # be sure that the superclass is 
-        # not potentially creating an issues 
+        # we need to check the metaclass
+        # compatability here so that we can
+        # be sure that the superclass is
+        # not potentially creating an issues
         # we don't know about
         $self->check_metaclass_compatability();
     }
@@ -386,16 +386,16 @@ sub class_precedence_list {
     # NOTE:
     # We need to check for ciruclar inheirtance here.
     # This will do nothing if all is well, and blow
-    # up otherwise. Yes, it's an ugly hack, better 
+    # up otherwise. Yes, it's an ugly hack, better
     # suggestions are welcome.
     { ($self->name || return)->isa('This is a test for circular inheritance') }
-    # ... and now back to our regularly scheduled program
+
     (
-        $self->name, 
-        map { 
+        $self->name,
+        map {
             $self->initialize($_)->class_precedence_list()
         } $self->superclasses()
-    );   
+    );
 }
 
 ## Methods
@@ -404,20 +404,20 @@ sub add_method {
     my ($self, $method_name, $method) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name";
-    
+
     my $body;
     if (blessed($method)) {
-        $body = $method->body;           
+        $body = $method->body;
     }
-    else {        
+    else {
         $body = $method;
         ('CODE' eq (reftype($body) || ''))
-            || confess "Your code block must be a CODE reference";        
-        $method = $self->method_metaclass->wrap($body);        
+            || confess "Your code block must be a CODE reference";
+        $method = $self->method_metaclass->wrap($body);
     }
     $self->get_method_map->{$method_name} = $method;
-    
-    my $full_method_name = ($self->name . '::' . $method_name);        
+
+    my $full_method_name = ($self->name . '::' . $method_name);
     $self->add_package_symbol("&${method_name}" => subname $full_method_name => $body);
 }
 
@@ -433,24 +433,24 @@ sub add_method {
             # die if it does not exist
             (defined $method)
                 || confess "The method '$method_name' is not found in the inheritance hierarchy for class " . $self->name;
-            # and now make sure to wrap it 
+            # and now make sure to wrap it
             # even if it is already wrapped
             # because we need a new sub ref
             $method = Class::MOP::Method::Wrapped->wrap($method);
         }
         else {
-            # now make sure we wrap it properly 
+            # now make sure we wrap it properly
             $method = Class::MOP::Method::Wrapped->wrap($method)
-                unless $method->isa('Class::MOP::Method::Wrapped');  
-        }    
-        $self->add_method($method_name => $method);        
+                unless $method->isa('Class::MOP::Method::Wrapped');
+        }
+        $self->add_method($method_name => $method);
         return $method;
     };
 
     sub add_before_method_modifier {
         my ($self, $method_name, $method_modifier) = @_;
         (defined $method_name && $method_name)
-            || confess "You must pass in a method name";    
+            || confess "You must pass in a method name";
         my $method = $fetch_and_prepare_method->($self, $method_name);
         $method->add_before_modifier(subname ':before' => $method_modifier);
     }
@@ -458,29 +458,29 @@ sub add_method {
     sub add_after_method_modifier {
         my ($self, $method_name, $method_modifier) = @_;
         (defined $method_name && $method_name)
-            || confess "You must pass in a method name";    
+            || confess "You must pass in a method name";
         my $method = $fetch_and_prepare_method->($self, $method_name);
         $method->add_after_modifier(subname ':after' => $method_modifier);
     }
-    
+
     sub add_around_method_modifier {
         my ($self, $method_name, $method_modifier) = @_;
         (defined $method_name && $method_name)
             || confess "You must pass in a method name";
         my $method = $fetch_and_prepare_method->($self, $method_name);
         $method->add_around_modifier(subname ':around' => $method_modifier);
-    }   
+    }
 
-    # NOTE: 
+    # NOTE:
     # the methods above used to be named like this:
     #    ${pkg}::${method}:(before|after|around)
     # but this proved problematic when using one modifier
     # to wrap multiple methods (something which is likely
     # to happen pretty regularly IMO). So instead of naming
-    # it like this, I have chosen to just name them purely 
+    # it like this, I have chosen to just name them purely
     # with their modifier names, like so:
     #    :(before|after|around)
-    # The fact is that in a stack trace, it will be fairly 
+    # The fact is that in a stack trace, it will be fairly
     # evident from the context what method they are attached
     # to, and so don't need the fully qualified name.
 }
@@ -492,17 +492,17 @@ sub alias_method {
 
     my $body = (blessed($method) ? $method->body : $method);
     ('CODE' eq (reftype($body) || ''))
-        || confess "Your code block must be a CODE reference";        
-        
+        || confess "Your code block must be a CODE reference";
+
     $self->add_package_symbol("&${method_name}" => $body);
 }
 
 sub has_method {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
-        || confess "You must define a method name";    
-    
-    return 0 unless exists $self->get_method_map->{$method_name};    
+        || confess "You must define a method name";
+
+    return 0 unless exists $self->get_method_map->{$method_name};
     return 1;
 }
 
@@ -510,13 +510,13 @@ sub get_method {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name";
-     
+
     # NOTE:
     # I don't really need this here, because
-    # if the method_map is missing a key it 
+    # if the method_map is missing a key it
     # will just return undef for me now
     # return unless $self->has_method($method_name);
+
     return $self->get_method_map->{$method_name};
 }
 
@@ -524,14 +524,14 @@ sub remove_method {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name";
-    
-    my $removed_method = $self->get_method($method_name);    
-    
-    do { 
+
+    my $removed_method = $self->get_method($method_name);
+
+    do {
         $self->remove_package_symbol("&${method_name}");
         delete $self->get_method_map->{$method_name};
     } if defined $removed_method;
-        
+
     return $removed_method;
 }
 
@@ -543,10 +543,10 @@ sub get_method_list {
 sub find_method_by_name {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
-        || confess "You must define a method name to find"; 
+        || confess "You must define a method name to find";
     # keep a record of what we have seen
-    # here, this will handle all the 
-    # inheritence issues because we are 
+    # here, this will handle all the
+    # inheritence issues because we are
     # using the &class_precedence_list
     my %seen_class;
     my @cpl = $self->class_precedence_list();
@@ -555,7 +555,7 @@ sub find_method_by_name {
         $seen_class{$class}++;
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
-        return $meta->get_method($method_name) 
+        return $meta->get_method($method_name)
             if $meta->has_method($method_name);
     }
     return;
@@ -565,8 +565,8 @@ sub compute_all_applicable_methods {
     my $self = shift;
     my @methods;
     # keep a record of what we have seen
-    # here, this will handle all the 
-    # inheritence issues because we are 
+    # here, this will handle all the
+    # inheritence issues because we are
     # using the &class_precedence_list
     my (%seen_class, %seen_method);
     foreach my $class ($self->class_precedence_list()) {
@@ -574,11 +574,11 @@ sub compute_all_applicable_methods {
         $seen_class{$class}++;
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
-        foreach my $method_name ($meta->get_method_list()) { 
+        foreach my $method_name ($meta->get_method_list()) {
             next if exists $seen_method{$method_name};
             $seen_method{$method_name}++;
             push @methods => {
-                name  => $method_name, 
+                name  => $method_name,
                 class => $class,
                 code  => $meta->get_method($method_name)
             };
@@ -590,11 +590,11 @@ sub compute_all_applicable_methods {
 sub find_all_methods_by_name {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
-        || confess "You must define a method name to find";    
+        || confess "You must define a method name to find";
     my @methods;
     # keep a record of what we have seen
-    # here, this will handle all the 
-    # inheritence issues because we are 
+    # here, this will handle all the
+    # inheritence issues because we are
     # using the &class_precedence_list
     my %seen_class;
     foreach my $class ($self->class_precedence_list()) {
@@ -603,7 +603,7 @@ sub find_all_methods_by_name {
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
         push @methods => {
-            name  => $method_name, 
+            name  => $method_name,
             class => $class,
             code  => $meta->get_method($method_name)
         } if $meta->has_method($method_name);
@@ -614,10 +614,10 @@ sub find_all_methods_by_name {
 sub find_next_method_by_name {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
-        || confess "You must define a method name to find"; 
+        || confess "You must define a method name to find";
     # keep a record of what we have seen
-    # here, this will handle all the 
-    # inheritence issues because we are 
+    # here, this will handle all the
+    # inheritence issues because we are
     # using the &class_precedence_list
     my %seen_class;
     my @cpl = $self->class_precedence_list();
@@ -627,7 +627,7 @@ sub find_next_method_by_name {
         $seen_class{$class}++;
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
-        return $meta->get_method($method_name) 
+        return $meta->get_method($method_name)
             if $meta->has_method($method_name);
     }
     return;
@@ -642,20 +642,20 @@ sub add_attribute {
     my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
     # make sure it is derived from the correct type though
     ($attribute->isa('Class::MOP::Attribute'))
-        || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";    
+        || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
 
     # first we attach our new attribute
-    # because it might need certain information 
+    # because it might need certain information
     # about the class which it is attached to
     $attribute->attach_to_class($self);
-    
-    # then we remove attributes of a conflicting 
-    # name here so that we can properly detach 
-    # the old attr object, and remove any 
+
+    # then we remove attributes of a conflicting
+    # name here so that we can properly detach
+    # the old attr object, and remove any
     # accessors it would have generated
     $self->remove_attribute($attribute->name)
         if $self->has_attribute($attribute->name);
-        
+
     # then onto installing the new accessors
     $attribute->install_accessors();
     $self->get_attribute_map->{$attribute->name} = $attribute;
@@ -665,43 +665,43 @@ sub has_attribute {
     my ($self, $attribute_name) = @_;
     (defined $attribute_name && $attribute_name)
         || confess "You must define an attribute name";
-    exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;    
-} 
+    exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
+}
 
 sub get_attribute {
     my ($self, $attribute_name) = @_;
     (defined $attribute_name && $attribute_name)
         || confess "You must define an attribute name";
-    return $self->get_attribute_map->{$attribute_name} 
+    return $self->get_attribute_map->{$attribute_name}
     # NOTE:
     # this will return undef anyway, so no need ...
-    #    if $self->has_attribute($attribute_name);   
-    #return; 
-} 
+    #    if $self->has_attribute($attribute_name);
+    #return;
+}
 
 sub remove_attribute {
     my ($self, $attribute_name) = @_;
     (defined $attribute_name && $attribute_name)
         || confess "You must define an attribute name";
-    my $removed_attribute = $self->get_attribute_map->{$attribute_name};    
+    my $removed_attribute = $self->get_attribute_map->{$attribute_name};
     return unless defined $removed_attribute;
-    delete $self->get_attribute_map->{$attribute_name};        
-    $removed_attribute->remove_accessors(); 
+    delete $self->get_attribute_map->{$attribute_name};
+    $removed_attribute->remove_accessors();
     $removed_attribute->detach_from_class();
     return $removed_attribute;
-} 
+}
 
 sub get_attribute_list {
     my $self = shift;
     keys %{$self->get_attribute_map};
-} 
+}
 
 sub compute_all_applicable_attributes {
     my $self = shift;
     my @attrs;
     # keep a record of what we have seen
-    # here, this will handle all the 
-    # inheritence issues because we are 
+    # here, this will handle all the
+    # inheritence issues because we are
     # using the &class_precedence_list
     my (%seen_class, %seen_attr);
     foreach my $class ($self->class_precedence_list()) {
@@ -709,20 +709,20 @@ sub compute_all_applicable_attributes {
         $seen_class{$class}++;
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
-        foreach my $attr_name ($meta->get_attribute_list()) { 
+        foreach my $attr_name ($meta->get_attribute_list()) {
             next if exists $seen_attr{$attr_name};
             $seen_attr{$attr_name}++;
             push @attrs => $meta->get_attribute($attr_name);
         }
     }
-    return @attrs;    
+    return @attrs;
 }
 
 sub find_attribute_by_name {
     my ($self, $attr_name) = @_;
     # keep a record of what we have seen
-    # here, this will handle all the 
-    # inheritence issues because we are 
+    # here, this will handle all the
+    # inheritence issues because we are
     # using the &class_precedence_list
     my %seen_class;
     foreach my $class ($self->class_precedence_list()) {
@@ -743,15 +743,17 @@ sub is_immutable { 0 }
 
 {
     # NOTE:
-    # the immutable version of a 
-    # particular metaclass is 
-    # really class-level data so 
-    # we don't want to regenerate 
+    # the immutable version of a
+    # particular metaclass is
+    # really class-level data so
+    # we don't want to regenerate
     # it any more than we need to
     my $IMMUTABLE_METACLASS;
+    my %IMMUTABLE_OPTIONS;
     sub make_immutable {
-        my ($self) = @_;
-        
+        my $self = shift;
+        %IMMUTABLE_OPTIONS = @_;
+
         $IMMUTABLE_METACLASS ||= Class::MOP::Immutable->new($self, {
             read_only   => [qw/superclasses/],
             cannot_call => [qw/
@@ -761,18 +763,25 @@ sub is_immutable { 0 }
                 add_attribute
                 remove_attribute
                 add_package_symbol
-                remove_package_symbol            
+                remove_package_symbol
             /],
             memoize     => {
                 class_precedence_list             => 'ARRAY',
-                compute_all_applicable_attributes => 'ARRAY',            
-                get_meta_instance                 => 'SCALAR',     
-                get_method_map                    => 'SCALAR',     
+                compute_all_applicable_attributes => 'ARRAY',
+                get_meta_instance                 => 'SCALAR',
+                get_method_map                    => 'SCALAR',
             }
-        });   
-        
-        $IMMUTABLE_METACLASS->make_metaclass_immutable(@_)     
+        });
+
+        $IMMUTABLE_METACLASS->make_metaclass_immutable($self, %IMMUTABLE_OPTIONS);
     }
+
+    sub make_mutable{
+        my $self = shift;
+        return if $self->is_mutable;
+        $IMMUTABLE_METACLASS->make_metaclass_mutable($self, %IMMUTABLE_OPTIONS);
+    }
+
 }
 
 1;
@@ -781,48 +790,48 @@ __END__
 
 =pod
 
-=head1 NAME 
+=head1 NAME
 
 Class::MOP::Class - Class Meta Object
 
 =head1 SYNOPSIS
 
-  # assuming that class Foo 
+  # assuming that class Foo
   # has been defined, you can
-  
+
   # use this for introspection ...
-  
+
   # add a method to Foo ...
   Foo->meta->add_method('bar' => sub { ... })
-  
-  # get a list of all the classes searched 
-  # the method dispatcher in the correct order 
+
+  # get a list of all the classes searched
+  # the method dispatcher in the correct order
   Foo->meta->class_precedence_list()
-  
+
   # remove a method from Foo
   Foo->meta->remove_method('bar');
-  
+
   # or use this to actually create classes ...
-  
+
   Class::MOP::Class->create('Bar' => (
       version      => '0.01',
       superclasses => [ 'Foo' ],
       attributes => [
           Class::MOP:::Attribute->new('$bar'),
-          Class::MOP:::Attribute->new('$baz'),          
+          Class::MOP:::Attribute->new('$baz'),
       ],
       methods => {
           calculate_bar => sub { ... },
-          construct_baz => sub { ... }          
+          construct_baz => sub { ... }
       }
   ));
 
 =head1 DESCRIPTION
 
-This is the largest and currently most complex part of the Perl 5 
-meta-object protocol. It controls the introspection and 
-manipulation of Perl 5 classes (and it can create them too). The 
-best way to understand what this module can do, is to read the 
+This is the largest and currently most complex part of the Perl 5
+meta-object protocol. It controls the introspection and
+manipulation of Perl 5 classes (and it can create them too). The
+best way to understand what this module can do, is to read the
 documentation for each of it's methods.
 
 =head1 METHODS
@@ -833,91 +842,91 @@ documentation for each of it's methods.
 
 =item B<meta>
 
-This will return a B<Class::MOP::Class> instance which is related 
-to this class. Thereby allowing B<Class::MOP::Class> to actually 
+This will return a B<Class::MOP::Class> instance which is related
+to this class. Thereby allowing B<Class::MOP::Class> to actually
 introspect itself.
 
-As with B<Class::MOP::Attribute>, B<Class::MOP> will actually 
-bootstrap this module by installing a number of attribute meta-objects 
-into it's metaclass. This will allow this class to reap all the benifits 
-of the MOP when subclassing it. 
+As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
+bootstrap this module by installing a number of attribute meta-objects
+into it's metaclass. This will allow this class to reap all the benifits
+of the MOP when subclassing it.
 
 =back
 
 =head2 Class construction
 
-These methods will handle creating B<Class::MOP::Class> objects, 
-which can be used to both create new classes, and analyze 
-pre-existing classes. 
+These methods will handle creating B<Class::MOP::Class> objects,
+which can be used to both create new classes, and analyze
+pre-existing classes.
 
-This module will internally store references to all the instances 
-you create with these methods, so that they do not need to be 
+This module will internally store references to all the instances
+you create with these methods, so that they do not need to be
 created any more than nessecary. Basically, they are singletons.
 
 =over 4
 
-=item B<create ($package_name, 
-                version      =E<gt> ?$version,                 
-                authority    =E<gt> ?$authority,                                 
-                superclasses =E<gt> ?@superclasses, 
-                methods      =E<gt> ?%methods, 
+=item B<create ($package_name,
+                version      =E<gt> ?$version,
+                authority    =E<gt> ?$authority,
+                superclasses =E<gt> ?@superclasses,
+                methods      =E<gt> ?%methods,
                 attributes   =E<gt> ?%attributes)>
 
-This returns a B<Class::MOP::Class> object, bringing the specified 
-C<$package_name> into existence and adding any of the C<$version>, 
-C<$authority>, C<@superclasses>, C<%methods> and C<%attributes> to 
+This returns a B<Class::MOP::Class> object, bringing the specified
+C<$package_name> into existence and adding any of the C<$version>,
+C<$authority>, C<@superclasses>, C<%methods> and C<%attributes> to
 it.
 
-=item B<create_anon_class (superclasses =E<gt> ?@superclasses, 
-                           methods      =E<gt> ?%methods, 
+=item B<create_anon_class (superclasses =E<gt> ?@superclasses,
+                           methods      =E<gt> ?%methods,
                            attributes   =E<gt> ?%attributes)>
 
-This will create an anonymous class, it works much like C<create> but 
-it does not need a C<$package_name>. Instead it will create a suitably 
+This will create an anonymous class, it works much like C<create> but
+it does not need a C<$package_name>. Instead it will create a suitably
 unique package name for you to stash things into.
 
-On very important distinction is that anon classes are destroyed once 
-the metaclass they are attached to goes out of scope. In the DESTROY 
-method, the created package will be removed from the symbol table. 
+On very important distinction is that anon classes are destroyed once
+the metaclass they are attached to goes out of scope. In the DESTROY
+method, the created package will be removed from the symbol table.
 
 It is also worth noting that any instances created with an anon-class
-will keep a special reference to the anon-meta which will prevent the 
-anon-class from going out of scope until all instances of it have also 
-been destroyed. This however only works for HASH based instance types, 
-as we use a special reserved slot (C<__MOP__>) to store this. 
+will keep a special reference to the anon-meta which will prevent the
+anon-class from going out of scope until all instances of it have also
+been destroyed. This however only works for HASH based instance types,
+as we use a special reserved slot (C<__MOP__>) to store this.
 
 =item B<initialize ($package_name, %options)>
 
-This initializes and returns returns a B<Class::MOP::Class> object 
+This initializes and returns returns a B<Class::MOP::Class> object
 for a given a C<$package_name>.
 
 =item B<reinitialize ($package_name, %options)>
 
 This removes the old metaclass, and creates a new one in it's place.
-Do B<not> use this unless you really know what you are doing, it could 
-very easily make a very large mess of your program. 
+Do B<not> use this unless you really know what you are doing, it could
+very easily make a very large mess of your program.
 
 =item B<construct_class_instance (%options)>
 
-This will construct an instance of B<Class::MOP::Class>, it is 
-here so that we can actually "tie the knot" for B<Class::MOP::Class> 
-to use C<construct_instance> once all the bootstrapping is done. This 
+This will construct an instance of B<Class::MOP::Class>, it is
+here so that we can actually "tie the knot" for B<Class::MOP::Class>
+to use C<construct_instance> once all the bootstrapping is done. This
 method is used internally by C<initialize> and should never be called
 from outside of that method really.
 
 =item B<check_metaclass_compatability>
 
-This method is called as the very last thing in the 
-C<construct_class_instance> method. This will check that the 
-metaclass you are creating is compatible with the metaclasses of all 
-your ancestors. For more inforamtion about metaclass compatibility 
+This method is called as the very last thing in the
+C<construct_class_instance> method. This will check that the
+metaclass you are creating is compatible with the metaclasses of all
+your ancestors. For more inforamtion about metaclass compatibility
 see the C<About Metaclass compatibility> section in L<Class::MOP>.
 
 =back
 
 =head2 Object instance construction and cloning
 
-These methods are B<entirely optional>, it is up to you whether you want 
+These methods are B<entirely optional>, it is up to you whether you want
 to use them or not.
 
 =over 4
@@ -928,37 +937,37 @@ to use them or not.
 
 =item B<new_object (%params)>
 
-This is a convience method for creating a new object of the class, and 
-blessing it into the appropriate package as well. Ideally your class 
+This is a convience method for creating a new object of the class, and
+blessing it into the appropriate package as well. Ideally your class
 would call a C<new> this method like so:
 
-  sub MyClass::new { 
+  sub MyClass::new {
       my ($class, %param) = @_;
       $class->meta->new_object(%params);
   }
 
-Of course the ideal place for this would actually be in C<UNIVERSAL::> 
+Of course the ideal place for this would actually be in C<UNIVERSAL::>
 but that is considered bad style, so we do not do that.
 
 =item B<construct_instance (%params)>
 
-This method is used to construct an instace structure suitable for 
-C<bless>-ing into your package of choice. It works in conjunction 
+This method is used to construct an instace structure suitable for
+C<bless>-ing into your package of choice. It works in conjunction
 with the Attribute protocol to collect all applicable attributes.
 
-This will construct and instance using a HASH ref as storage 
-(currently only HASH references are supported). This will collect all 
-the applicable attributes and layout out the fields in the HASH ref, 
-it will then initialize them using either use the corresponding key 
-in C<%params> or any default value or initializer found in the 
+This will construct and instance using a HASH ref as storage
+(currently only HASH references are supported). This will collect all
+the applicable attributes and layout out the fields in the HASH ref,
+it will then initialize them using either use the corresponding key
+in C<%params> or any default value or initializer found in the
 attribute meta-object.
 
 =item B<clone_object ($instance, %params)>
 
-This is a convience method for cloning an object instance, then  
-blessing it into the appropriate package. This method will call 
-C<clone_instance>, which performs a shallow copy of the object, 
-see that methods documentation for more details. Ideally your 
+This is a convience method for cloning an object instance, then
+blessing it into the appropriate package. This method will call
+C<clone_instance>, which performs a shallow copy of the object,
+see that methods documentation for more details. Ideally your
 class would call a C<clone> this method like so:
 
   sub MyClass::clone {
@@ -966,30 +975,30 @@ class would call a C<clone> this method like so:
       $self->meta->clone_object($self, %params);
   }
 
-Of course the ideal place for this would actually be in C<UNIVERSAL::> 
+Of course the ideal place for this would actually be in C<UNIVERSAL::>
 but that is considered bad style, so we do not do that.
 
 =item B<clone_instance($instance, %params)>
 
-This method is a compliment of C<construct_instance> (which means if 
-you override C<construct_instance>, you need to override this one too), 
+This method is a compliment of C<construct_instance> (which means if
+you override C<construct_instance>, you need to override this one too),
 and clones the instance shallowly.
 
-The cloned structure returned is (like with C<construct_instance>) an 
-unC<bless>ed HASH reference, it is your responsibility to then bless 
+The cloned structure returned is (like with C<construct_instance>) an
+unC<bless>ed HASH reference, it is your responsibility to then bless
 this cloned structure into the right class (which C<clone_object> will
 do for you).
 
-As of 0.11, this method will clone the C<$instance> structure shallowly, 
-as opposed to the deep cloning implemented in prior versions. After much 
-thought, research and discussion, I have decided that anything but basic 
-shallow cloning is outside the scope of the meta-object protocol. I 
-think Yuval "nothingmuch" Kogman put it best when he said that cloning 
+As of 0.11, this method will clone the C<$instance> structure shallowly,
+as opposed to the deep cloning implemented in prior versions. After much
+thought, research and discussion, I have decided that anything but basic
+shallow cloning is outside the scope of the meta-object protocol. I
+think Yuval "nothingmuch" Kogman put it best when he said that cloning
 is too I<context-specific> to be part of the MOP.
 
 =back
 
-=head2 Informational 
+=head2 Informational
 
 These are a few predicate methods for asking information about the class.
 
@@ -1015,21 +1024,21 @@ This returns true if the class has been made immutable.
 
 =item B<superclasses (?@superclasses)>
 
-This is a read-write attribute which represents the superclass 
+This is a read-write attribute which represents the superclass
 relationships of the class the B<Class::MOP::Class> instance is
 associated with. Basically, it can get and set the C<@ISA> for you.
 
 B<NOTE:>
-Perl will occasionally perform some C<@ISA> and method caching, if 
-you decide to change your superclass relationship at runtime (which 
-is quite insane and very much not recommened), then you should be 
-aware of this and the fact that this module does not make any 
+Perl will occasionally perform some C<@ISA> and method caching, if
+you decide to change your superclass relationship at runtime (which
+is quite insane and very much not recommened), then you should be
+aware of this and the fact that this module does not make any
 attempt to address this issue.
 
 =item B<class_precedence_list>
 
-This computes the a list of all the class's ancestors in the same order 
-in which method dispatch will be done. This is similair to 
+This computes the a list of all the class's ancestors in the same order
+in which method dispatch will be done. This is similair to
 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
 
 =back
@@ -1044,55 +1053,55 @@ what B<Class::ISA::super_path> does, but we don't remove duplicate names.
 
 =item B<add_method ($method_name, $method)>
 
-This will take a C<$method_name> and CODE reference to that 
-C<$method> and install it into the class's package. 
+This will take a C<$method_name> and CODE reference to that
+C<$method> and install it into the class's package.
 
-B<NOTE>: 
-This does absolutely nothing special to C<$method> 
-other than use B<Sub::Name> to make sure it is tagged with the 
-correct name, and therefore show up correctly in stack traces and 
+B<NOTE>:
+This does absolutely nothing special to C<$method>
+other than use B<Sub::Name> to make sure it is tagged with the
+correct name, and therefore show up correctly in stack traces and
 such.
 
 =item B<alias_method ($method_name, $method)>
 
-This will take a C<$method_name> and CODE reference to that 
-C<$method> and alias the method into the class's package. 
+This will take a C<$method_name> and CODE reference to that
+C<$method> and alias the method into the class's package.
 
-B<NOTE>: 
-Unlike C<add_method>, this will B<not> try to name the 
-C<$method> using B<Sub::Name>, it only aliases the method in 
-the class's package. 
+B<NOTE>:
+Unlike C<add_method>, this will B<not> try to name the
+C<$method> using B<Sub::Name>, it only aliases the method in
+the class's package.
 
 =item B<has_method ($method_name)>
 
-This just provides a simple way to check if the class implements 
-a specific C<$method_name>. It will I<not> however, attempt to check 
+This just provides a simple way to check if the class implements
+a specific C<$method_name>. It will I<not> however, attempt to check
 if the class inherits the method (use C<UNIVERSAL::can> for that).
 
-This will correctly handle functions defined outside of the package 
+This will correctly handle functions defined outside of the package
 that use a fully qualified name (C<sub Package::name { ... }>).
 
-This will correctly handle functions renamed with B<Sub::Name> and 
-installed using the symbol tables. However, if you are naming the 
-subroutine outside of the package scope, you must use the fully 
-qualified name, including the package name, for C<has_method> to 
-correctly identify it. 
+This will correctly handle functions renamed with B<Sub::Name> and
+installed using the symbol tables. However, if you are naming the
+subroutine outside of the package scope, you must use the fully
+qualified name, including the package name, for C<has_method> to
+correctly identify it.
 
-This will attempt to correctly ignore functions imported from other 
-packages using B<Exporter>. It breaks down if the function imported 
-is an C<__ANON__> sub (such as with C<use constant>), which very well 
-may be a valid method being applied to the class. 
+This will attempt to correctly ignore functions imported from other
+packages using B<Exporter>. It breaks down if the function imported
+is an C<__ANON__> sub (such as with C<use constant>), which very well
+may be a valid method being applied to the class.
 
-In short, this method cannot always be trusted to determine if the 
-C<$method_name> is actually a method. However, it will DWIM about 
+In short, this method cannot always be trusted to determine if the
+C<$method_name> is actually a method. However, it will DWIM about
 90% of the time, so it's a small trade off I think.
 
 =item B<get_method ($method_name)>
 
-This will return a Class::MOP::Method instance related to the specified 
+This will return a Class::MOP::Method instance related to the specified
 C<$method_name>, or return undef if that method does not exist.
 
-The Class::MOP::Method is codifiable, so you can use it like a normal 
+The Class::MOP::Method is codifiable, so you can use it like a normal
 CODE reference, see L<Class::MOP::Method> for more information.
 
 =item B<find_method_by_name ($method_name>
@@ -1104,76 +1113,76 @@ Unlike C<get_method> this will also look in the superclasses.
 
 =item B<remove_method ($method_name)>
 
-This will attempt to remove a given C<$method_name> from the class. 
-It will return the CODE reference that it has removed, and will 
+This will attempt to remove a given C<$method_name> from the class.
+It will return the CODE reference that it has removed, and will
 attempt to use B<Sub::Name> to clear the methods associated name.
 
 =item B<get_method_list>
 
-This will return a list of method names for all I<locally> defined 
-methods. It does B<not> provide a list of all applicable methods, 
-including any inherited ones. If you want a list of all applicable 
+This will return a list of method names for all I<locally> defined
+methods. It does B<not> provide a list of all applicable methods,
+including any inherited ones. If you want a list of all applicable
 methods, use the C<compute_all_applicable_methods> method.
 
 =item B<compute_all_applicable_methods>
 
-This will return a list of all the methods names this class will 
-respond to, taking into account inheritance. The list will be a list of 
-HASH references, each one containing the following information; method 
-name, the name of the class in which the method lives and a CODE 
+This will return a list of all the methods names this class will
+respond to, taking into account inheritance. The list will be a list of
+HASH references, each one containing the following information; method
+name, the name of the class in which the method lives and a CODE
 reference for the actual method.
 
 =item B<find_all_methods_by_name ($method_name)>
 
-This will traverse the inheritence hierarchy and locate all methods 
-with a given C<$method_name>. Similar to 
-C<compute_all_applicable_methods> it returns a list of HASH references 
-with the following information; method name (which will always be the 
-same as C<$method_name>), the name of the class in which the method 
+This will traverse the inheritence hierarchy and locate all methods
+with a given C<$method_name>. Similar to
+C<compute_all_applicable_methods> it returns a list of HASH references
+with the following information; method name (which will always be the
+same as C<$method_name>), the name of the class in which the method
 lives and a CODE reference for the actual method.
 
-The list of methods produced is a distinct list, meaning there are no 
-duplicates in it. This is especially useful for things like object 
-initialization and destruction where you only want the method called 
+The list of methods produced is a distinct list, meaning there are no
+duplicates in it. This is especially useful for things like object
+initialization and destruction where you only want the method called
 once, and in the correct order.
 
 =item B<find_next_method_by_name ($method_name)>
 
-This will return the first method to match a given C<$method_name> in 
-the superclasses, this is basically equivalent to calling 
+This will return the first method to match a given C<$method_name> in
+the superclasses, this is basically equivalent to calling
 C<SUPER::$method_name>, but it can be dispatched at runtime.
 
 =back
 
 =head2 Method Modifiers
 
-Method modifiers are a concept borrowed from CLOS, in which a method 
-can be wrapped with I<before>, I<after> and I<around> method modifiers 
-that will be called everytime the method is called. 
+Method modifiers are a concept borrowed from CLOS, in which a method
+can be wrapped with I<before>, I<after> and I<around> method modifiers
+that will be called everytime the method is called.
 
 =head3 How method modifiers work?
 
-Method modifiers work by wrapping the original method and then replacing 
-it in the classes symbol table. The wrappers will handle calling all the 
-modifiers in the appropariate orders and preserving the calling context 
-for the original method. 
-
-Each method modifier serves a particular purpose, which may not be 
-obvious to users of other method wrapping modules. To start with, the 
-return values of I<before> and I<after> modifiers are ignored. This is 
-because thier purpose is B<not> to filter the input and output of the 
-primary method (this is done with an I<around> modifier). This may seem 
-like an odd restriction to some, but doing this allows for simple code 
-to be added at the begining or end of a method call without jeapordizing 
-the normal functioning of the primary method or placing any extra 
-responsibility on the code of the modifier. Of course if you have more 
-complex needs, then use the I<around> modifier, which uses a variation 
-of continutation passing style to allow for a high degree of flexibility. 
-
-Before and around modifiers are called in last-defined-first-called order, 
-while after modifiers are called in first-defined-first-called order. So 
+Method modifiers work by wrapping the original method and then replacing
+it in the classes symbol table. The wrappers will handle calling all the
+modifiers in the appropariate orders and preserving the calling context
+for the original method.
+
+Each method modifier serves a particular purpose, which may not be
+obvious to users of other method wrapping modules. To start with, the
+return values of I<before> and I<after> modifiers are ignored. This is
+because thier purpose is B<not> to filter the input and output of the
+primary method (this is done with an I<around> modifier). This may seem
+like an odd restriction to some, but doing this allows for simple code
+to be added at the begining or end of a method call without jeapordizing
+the normal functioning of the primary method or placing any extra
+responsibility on the code of the modifier. Of course if you have more
+complex needs, then use the I<around> modifier, which uses a variation
+of continutation passing style to allow for a high degree of flexibility.
+
+Before and around modifiers are called in last-defined-first-called order,
+while after modifiers are called in first-defined-first-called order. So
 the call tree might looks something like this:
-  
+
   before 2
    before 1
     around 2
@@ -1182,19 +1191,19 @@ the call tree might looks something like this:
      after 1
     after 2
 
-To see examples of using method modifiers, see the following examples 
-included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>, 
-F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a 
+To see examples of using method modifiers, see the following examples
+included in the distribution; F<InstanceCountingClass>, F<Perl6Attribute>,
+F<AttributesWithHistory> and F<C3MethodDispatchOrder>. There is also a
 classic CLOS usage example in the test F<017_add_method_modifier.t>.
 
 =head3 What is the performance impact?
 
-Of course there is a performance cost associated with method modifiers, 
-but we have made every effort to make that cost be directly proportional 
+Of course there is a performance cost associated with method modifiers,
+but we have made every effort to make that cost be directly proportional
 to the amount of modifier features you utilize.
 
-The wrapping method does it's best to B<only> do as much work as it 
-absolutely needs to. In order to do this we have moved some of the 
+The wrapping method does it's best to B<only> do as much work as it
+absolutely needs to. In order to do this we have moved some of the
 performance costs to set-up time, where they are easier to amortize.
 
 All this said, my benchmarks have indicated the following:
@@ -1205,49 +1214,49 @@ All this said, my benchmarks have indicated the following:
   simple wrapper with simple around modifier   500-550% slower
   simple wrapper with all 3 modifiers          1100% slower
 
-These numbers may seem daunting, but you must remember, every feature 
-comes with some cost. To put things in perspective, just doing a simple 
+These numbers may seem daunting, but you must remember, every feature
+comes with some cost. To put things in perspective, just doing a simple
 C<AUTOLOAD> which does nothing but extract the name of the method called
-and return it costs about 400% over a normal method call. 
+and return it costs about 400% over a normal method call.
 
 =over 4
 
 =item B<add_before_method_modifier ($method_name, $code)>
 
-This will wrap the method at C<$method_name> and the supplied C<$code> 
-will be passed the C<@_> arguments, and called before the original 
-method is called. As specified above, the return value of the I<before> 
-method modifiers is ignored, and it's ability to modify C<@_> is 
-fairly limited. If you need to do either of these things, use an 
+This will wrap the method at C<$method_name> and the supplied C<$code>
+will be passed the C<@_> arguments, and called before the original
+method is called. As specified above, the return value of the I<before>
+method modifiers is ignored, and it's ability to modify C<@_> is
+fairly limited. If you need to do either of these things, use an
 C<around> method modifier.
 
 =item B<add_after_method_modifier ($method_name, $code)>
 
-This will wrap the method at C<$method_name> so that the original 
-method will be called, it's return values stashed, and then the 
+This will wrap the method at C<$method_name> so that the original
+method will be called, it's return values stashed, and then the
 supplied C<$code> will be passed the C<@_> arguments, and called.
-As specified above, the return value of the I<after> method 
-modifiers is ignored, and it cannot modify the return values of 
-the original method. If you need to do either of these things, use an 
+As specified above, the return value of the I<after> method
+modifiers is ignored, and it cannot modify the return values of
+the original method. If you need to do either of these things, use an
 C<around> method modifier.
 
 =item B<add_around_method_modifier ($method_name, $code)>
 
-This will wrap the method at C<$method_name> so that C<$code> 
-will be called and passed the original method as an extra argument 
-at the begining of the C<@_> argument list. This is a variation of 
-continuation passing style, where the function prepended to C<@_> 
-can be considered a continuation. It is up to C<$code> if it calls 
-the original method or not, there is no restriction on what the 
+This will wrap the method at C<$method_name> so that C<$code>
+will be called and passed the original method as an extra argument
+at the begining of the C<@_> argument list. This is a variation of
+continuation passing style, where the function prepended to C<@_>
+can be considered a continuation. It is up to C<$code> if it calls
+the original method or not, there is no restriction on what the
 C<$code> can or cannot do.
 
 =back
 
 =head2 Attributes
 
-It should be noted that since there is no one consistent way to define 
-the attributes of a class in Perl 5. These methods can only work with 
-the information given, and can not easily discover information on 
+It should be noted that since there is no one consistent way to define
+the attributes of a class in Perl 5. These methods can only work with
+the information given, and can not easily discover information on
 their own. See L<Class::MOP::Attribute> for more details.
 
 =over 4
@@ -1259,68 +1268,68 @@ their own. See L<Class::MOP::Attribute> for more details.
 =item B<add_attribute ($attribute_meta_object | $attribute_name, %attribute_spec)>
 
 This stores the C<$attribute_meta_object> (or creates one from the
-C<$attribute_name> and C<%attribute_spec>) in the B<Class::MOP::Class> 
-instance associated with the given class. Unlike methods, attributes 
-within the MOP are stored as meta-information only. They will be used 
+C<$attribute_name> and C<%attribute_spec>) in the B<Class::MOP::Class>
+instance associated with the given class. Unlike methods, attributes
+within the MOP are stored as meta-information only. They will be used
 later to construct instances from (see C<construct_instance> above).
-More details about the attribute meta-objects can be found in the 
+More details about the attribute meta-objects can be found in the
 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
 section.
 
-It should be noted that any accessor, reader/writer or predicate 
-methods which the C<$attribute_meta_object> has will be installed 
+It should be noted that any accessor, reader/writer or predicate
+methods which the C<$attribute_meta_object> has will be installed
 into the class at this time.
 
 B<NOTE>
-If an attribute already exists for C<$attribute_name>, the old one 
-will be removed (as well as removing all it's accessors), and then 
+If an attribute already exists for C<$attribute_name>, the old one
+will be removed (as well as removing all it's accessors), and then
 the new one added.
 
 =item B<has_attribute ($attribute_name)>
 
-Checks to see if this class has an attribute by the name of 
+Checks to see if this class has an attribute by the name of
 C<$attribute_name> and returns a boolean.
 
 =item B<get_attribute ($attribute_name)>
 
-Returns the attribute meta-object associated with C<$attribute_name>, 
-if none is found, it will return undef. 
+Returns the attribute meta-object associated with C<$attribute_name>,
+if none is found, it will return undef.
 
 =item B<remove_attribute ($attribute_name)>
 
-This will remove the attribute meta-object stored at 
-C<$attribute_name>, then return the removed attribute meta-object. 
+This will remove the attribute meta-object stored at
+C<$attribute_name>, then return the removed attribute meta-object.
 
-B<NOTE:> 
-Removing an attribute will only affect future instances of 
-the class, it will not make any attempt to remove the attribute from 
+B<NOTE:>
+Removing an attribute will only affect future instances of
+the class, it will not make any attempt to remove the attribute from
 any existing instances of the class.
 
-It should be noted that any accessor, reader/writer or predicate 
-methods which the attribute meta-object stored at C<$attribute_name> 
-has will be removed from the class at this time. This B<will> make 
-these attributes somewhat inaccessable in previously created 
-instances. But if you are crazy enough to do this at runtime, then 
+It should be noted that any accessor, reader/writer or predicate
+methods which the attribute meta-object stored at C<$attribute_name>
+has will be removed from the class at this time. This B<will> make
+these attributes somewhat inaccessable in previously created
+instances. But if you are crazy enough to do this at runtime, then
 you are crazy enough to deal with something like this :).
 
 =item B<get_attribute_list>
 
-This returns a list of attribute names which are defined in the local 
-class. If you want a list of all applicable attributes for a class, 
+This returns a list of attribute names which are defined in the local
+class. If you want a list of all applicable attributes for a class,
 use the C<compute_all_applicable_attributes> method.
 
 =item B<compute_all_applicable_attributes>
 
-This will traverse the inheritance heirachy and return a list of all 
-the applicable attributes for this class. It does not construct a 
-HASH reference like C<compute_all_applicable_methods> because all 
-that same information is discoverable through the attribute 
+This will traverse the inheritance heirachy and return a list of all
+the applicable attributes for this class. It does not construct a
+HASH reference like C<compute_all_applicable_methods> because all
+that same information is discoverable through the attribute
 meta-object itself.
 
 =item B<find_attribute_by_name ($attr_name)>
 
-This method will traverse the inheritance heirachy and find the 
-first attribute whose name matches C<$attr_name>, then return it. 
+This method will traverse the inheritance heirachy and find the
+first attribute whose name matches C<$attr_name>, then return it.
 It will return undef if nothing is found.
 
 =back
@@ -1331,10 +1340,15 @@ It will return undef if nothing is found.
 
 =item B<make_immutable (%options)>
 
-This method will invoke a tranforamtion upon the class which will 
-make it immutable. Details of this transformation can be found in 
+This method will invoke a tranforamtion upon the class which will
+make it immutable. Details of this transformation can be found in
 the L<Class::MOP::Immutable> documentation.
 
+=item B<make_mutable>
+
+This method will reverse tranforamtion upon the class which
+made it immutable.
+
 =back
 
 =head1 AUTHORS
@@ -1348,6 +1362,6 @@ Copyright 2006, 2007 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. 
+it under the same terms as Perl itself.
 
 =cut
index 5e6a3a6..1d91c8d 100644 (file)
@@ -12,20 +12,20 @@ use Scalar::Util 'blessed';
 our $VERSION   = '0.01';
 our $AUTHORITY = 'cpan:STEVAN';
 
-sub new { 
+sub new {
     my ($class, $metaclass, $options) = @_;
-    
+
     my $self = bless {
         '$!metaclass'           => $metaclass,
         '%!options'             => $options,
         '$!immutable_metaclass' => undef,
     } => $class;
-    
+
     # NOTE:
-    # we initialize the immutable 
+    # we initialize the immutable
     # version of the metaclass here
     $self->create_immutable_metaclass;
-    
+
     return $self;
 }
 
@@ -37,23 +37,23 @@ sub create_immutable_metaclass {
     my $self = shift;
 
     # NOTE:
-    # The immutable version of the 
+    # The immutable version of the
     # metaclass is just a anon-class
-    # which shadows the methods 
+    # which shadows the methods
     # appropriately
     $self->{'$!immutable_metaclass'} = Class::MOP::Class->create_anon_class(
         superclasses => [ blessed($self->metaclass) ],
         methods      => $self->create_methods_for_immutable_metaclass,
-    ); 
+    );
 }
 
 my %DEFAULT_METHODS = (
-    meta => sub { 
+    meta => sub {
         my $self = shift;
-        # if it is not blessed, then someone is asking 
+        # if it is not blessed, then someone is asking
         # for the meta of Class::MOP::Class::Immutable
         return Class::MOP::Class->initialize($self) unless blessed($self);
-        # otherwise, they are asking for the metaclass 
+        # otherwise, they are asking for the metaclass
         # which has been made immutable, which is itself
         return $self;
     },
@@ -63,107 +63,156 @@ my %DEFAULT_METHODS = (
 );
 
 # NOTE:
-# this will actually convert the 
-# existing metaclass to an immutable 
+# this will actually convert the
+# existing metaclass to an immutable
 # version of itself
 sub make_metaclass_immutable {
     my ($self, $metaclass, %options) = @_;
-    
+
     $options{inline_accessors}   = 1     unless exists $options{inline_accessors};
     $options{inline_constructor} = 1     unless exists $options{inline_constructor};
-    $options{inline_destructor}  = 0     unless exists $options{inline_destructor};    
+    $options{inline_destructor}  = 0     unless exists $options{inline_destructor};
     $options{constructor_name}   = 'new' unless exists $options{constructor_name};
-    $options{debug}              = 0     unless exists $options{debug};    
-    
+    $options{debug}              = 0     unless exists $options{debug};
+
     if ($options{inline_accessors}) {
         foreach my $attr_name ($metaclass->get_attribute_list) {
             # inline the accessors
             $metaclass->get_attribute($attr_name)
-                      ->install_accessors(1); 
-        }      
+                      ->install_accessors(1);
+        }
     }
 
-    if ($options{inline_constructor}) {       
+    if ($options{inline_constructor}) {
         my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor';
-        
+
         $metaclass->add_method(
             $options{constructor_name},
             $constructor_class->new(
-                options   => \%options,           
-                metaclass => $metaclass,                
+                options   => \%options,
+                metaclass => $metaclass,
             )
         ) unless $metaclass->has_method($options{constructor_name});
-    }    
-    
-    if ($options{inline_destructor}) {       
+    }
+
+    if ($options{inline_destructor}) {
         (exists $options{destructor_class})
             || confess "The 'inline_destructor' option is present, but "
                      . "no destructor class was specified";
-        
+
         my $destructor_class = $options{destructor_class};
-        
+
         my $destructor = $destructor_class->new(
             options   => \%options,
             metaclass => $metaclass,
         );
-        
-        $metaclass->add_method('DESTROY' => $destructor) 
+
+        $metaclass->add_method('DESTROY' => $destructor)
             # NOTE:
-            # we allow the destructor to determine 
+            # we allow the destructor to determine
             # if it is needed or not, it can perform
-            # all sorts of checks because it has the 
-            # metaclass instance 
+            # all sorts of checks because it has the
+            # metaclass instance
             if $destructor->is_needed;
-    }    
-    
+    }
+
     my $memoized_methods = $self->options->{memoize};
     foreach my $method_name (keys %{$memoized_methods}) {
         my $type = $memoized_methods->{$method_name};
-    
+
         ($metaclass->can($method_name))
-            || confess "Could not find the method '$method_name' in " . $metaclass->name;        
-    
-        my $memoized_method;
+            || confess "Could not find the method '$method_name' in " . $metaclass->name;
+
         if ($type eq 'ARRAY') {
             $metaclass->{'___' . $method_name} = [ $metaclass->$method_name ];
         }
         elsif ($type eq 'HASH') {
-            $metaclass->{'___' . $method_name} = { $metaclass->$method_name };                       
+            $metaclass->{'___' . $method_name} = { $metaclass->$method_name };
         }
         elsif ($type eq 'SCALAR') {
             $metaclass->{'___' . $method_name} = $metaclass->$method_name;
         }
-    }  
-    $metaclass->{'___original_class'} = blessed($metaclass);    
+    }
+
+    #I'm not sure i understand this, stevan suggested the addition i don't think its actually needed
+    #my $is_immutable = $metaclass->is_anon_class;
+    #$self->immutable_metaclass->add_method('is_anon_class' => sub { $is_immutable });
 
+    $metaclass->{'___original_class'} = blessed($metaclass);
     bless $metaclass => $self->immutable_metaclass->name;
 }
 
+sub make_metaclass_mutable {
+    my ($self, $immutable, %options) = @_;
+
+    my $original_class = $immutable->get_mutable_metaclass_name;
+    delete $immutable->{'___original_class'} ;
+    bless $immutable => $original_class;
+
+    my $memoized_methods = $self->options->{memoize};
+    foreach my $method_name (keys %{$memoized_methods}) {
+        my $type = $memoized_methods->{$method_name};
+
+        ($immutable->can($method_name))
+          || confess "Could not find the method '$method_name' in " . $immutable->name;
+        if ($type eq 'SCALAR' || $type eq 'ARRAY' ||  $type eq 'HASH' ) {
+            delete $immutable->{'___' . $method_name};
+        }
+    }
+
+    if ($options{inline_destructor} && $immutable->has_method('DESTROY')) {
+        $immutable->remove_method('DESTROY')
+          if $immutable->get_method('DESTROY')->blessed eq $options{destructor_class};
+    }
+
+    #14:01 <@stevan> nah,. you shouldnt
+    #14:01 <@stevan> they are just inlined
+    #14:01 <@stevan> which is the default in Moose anyway
+    #14:02 <@stevan> and adding new attributes will just DWIM
+    #14:02 <@stevan> and you really cant change an attribute anyway
+    #if ($options{inline_accessors}) {
+    #    foreach my $attr_name ($immutable->get_attribute_list) {
+    #        my $attr = $immutable->get_attribute($attr_name);
+    #        $attr->remove_accessors;
+    #        $attr->install_accessors(0);
+    #    }
+    #}
+
+    #14:26 <@stevan> the only user of ::Method::Constructor is immutable
+    #14:27 <@stevan> if someone uses it outside of immutable,.. they are either: mst or groditi
+    #14:27 <@stevan> so I am not worried
+    $options{constructor_name} = 'new' unless exists $options{constructor_name};
+    if ($options{inline_constructor}) {
+        my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor';
+        $immutable->remove_method( $options{constructor_name}  )
+          if $immutable->get_method($options{constructor_name})->blessed eq $constructor_class;
+    }
+}
+
 sub create_methods_for_immutable_metaclass {
     my $self = shift;
-    
+
     my %methods = %DEFAULT_METHODS;
-    
+
     foreach my $read_only_method (@{$self->options->{read_only}}) {
         my $method = $self->metaclass->meta->find_method_by_name($read_only_method);
-        
+
         (defined $method)
             || confess "Could not find the method '$read_only_method' in " . $self->metaclass->name;
-        
+
         $methods{$read_only_method} = sub {
             confess "This method is read-only" if scalar @_ > 1;
             goto &{$method->body}
         };
     }
-    
+
     foreach my $cannot_call_method (@{$self->options->{cannot_call}}) {
         $methods{$cannot_call_method} = sub {
             confess "This method ($cannot_call_method) cannot be called on an immutable instance";
         };
-    }  
-    
+    }
+
     my $memoized_methods = $self->options->{memoize};
-    
     foreach my $method_name (keys %{$memoized_methods}) {
         my $type = $memoized_methods->{$method_name};
         if ($type eq 'ARRAY') {
@@ -174,11 +223,11 @@ sub create_methods_for_immutable_metaclass {
         }
         elsif ($type eq 'SCALAR') {
             $methods{$method_name} = sub { $_[0]->{'___' . $method_name} };
-        }        
-    }       
-    
-    $methods{get_mutable_metaclass_name} = sub { (shift)->{'___original_class'} };     
-    
+        }
+    }
+
+    $methods{get_mutable_metaclass_name} = sub { (shift)->{'___original_class'} };
+
     return \%methods;
 }
 
@@ -188,14 +237,14 @@ __END__
 
 =pod
 
-=head1 NAME 
+=head1 NAME
 
 Class::MOP::Immutable - A class to transform Class::MOP::Class metaclasses
 
 =head1 SYNOPSIS
 
     use Class::MOP::Immutable;
-    
+
     my $immutable_metaclass = Class::MOP::Immutable->new($metaclass, {
         read_only   => [qw/superclasses/],
         cannot_call => [qw/
@@ -205,26 +254,26 @@ Class::MOP::Immutable - A class to transform Class::MOP::Class metaclasses
             add_attribute
             remove_attribute
             add_package_symbol
-            remove_package_symbol            
+            remove_package_symbol
         /],
         memoize     => {
             class_precedence_list             => 'ARRAY',
-            compute_all_applicable_attributes => 'ARRAY',            
-            get_meta_instance                 => 'SCALAR',     
-            get_method_map                    => 'SCALAR',     
+            compute_all_applicable_attributes => 'ARRAY',
+            get_meta_instance                 => 'SCALAR',
+            get_method_map                    => 'SCALAR',
         }
-    });   
+    });
 
     $immutable_metaclass->make_metaclass_immutable(@_)
 
 =head1 DESCRIPTION
 
-This is basically a module for applying a transformation on a given 
-metaclass. Current features include making methods read-only, 
+This is basically a module for applying a transformation on a given
+metaclass. Current features include making methods read-only,
 making methods un-callable and memoizing methods (in a type specific
-way too). 
+way too).
 
-This module is fairly new to the MOP, and quite possibly will be 
+This module is fairly new to the MOP, and quite possibly will be
 expanded and further generalized as the need arises.
 
 =head1 METHODS
@@ -233,9 +282,9 @@ expanded and further generalized as the need arises.
 
 =item B<new ($metaclass, \%options)>
 
-Given a C<$metaclass> and a set of C<%options> this module will  
-prepare an immutable version of the C<$metaclass>, which can then 
-be applied to the C<$metaclass> using the C<make_metaclass_immutable> 
+Given a C<$metaclass> and a set of C<%options> this module will
+prepare an immutable version of the C<$metaclass>, which can then
+be applied to the C<$metaclass> using the C<make_metaclass_immutable>
 method.
 
 =item B<options>
@@ -256,18 +305,24 @@ Returns the immutable metaclass created within C<new>.
 
 =item B<create_immutable_metaclass>
 
-This will create the immutable version of the C<$metaclass>, but will 
-not actually change the original metaclass. 
+This will create the immutable version of the C<$metaclass>, but will
+not actually change the original metaclass.
 
 =item B<create_methods_for_immutable_metaclass>
 
-This will create all the methods for the immutable metaclass based 
+This will create all the methods for the immutable metaclass based
 on the C<%options> passed into C<new>.
 
-=item B<make_metaclass_immutable>
+=item B<make_metaclass_immutable (%options)>
 
 This will actually change the C<$metaclass> into the immutable version.
 
+=item B<make_metaclass_mutable (%options)>
+
+This will change the C<$metaclass> into the mutable version by reversing
+the immutable process. C<%options> should be the same options that were
+given to make_metaclass_immutable.
+
 =back
 
 =head1 AUTHORS
@@ -281,6 +336,6 @@ Copyright 2006, 2007 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. 
+it under the same terms as Perl itself.
 
 =cut
index fba4d05..06ae7f0 100644 (file)
@@ -3,14 +3,14 @@
 use strict;
 use warnings;
 
-use Test::More tests => 191;
+use Test::More tests => 193;
 use Test::Exception;
 
 BEGIN {
     use_ok('Class::MOP');
-    use_ok('Class::MOP::Class');        
-    use_ok('Class::MOP::Package');        
-    use_ok('Class::MOP::Module');                
+    use_ok('Class::MOP::Class');
+    use_ok('Class::MOP::Package');
+    use_ok('Class::MOP::Module');
 }
 
 {
@@ -28,66 +28,66 @@ my $class_mop_module_meta = Class::MOP::Module->meta();
 isa_ok($class_mop_module_meta, 'Class::MOP::Module');
 
 my @class_mop_package_methods = qw(
-    meta 
+    meta
 
     initialize
 
     name
     namespace
-    
-    add_package_symbol get_package_symbol has_package_symbol remove_package_symbol 
+
+    add_package_symbol get_package_symbol has_package_symbol remove_package_symbol
     list_all_package_symbols remove_package_glob
-    
+
     _deconstruct_variable_name
 );
 
 my @class_mop_module_methods = qw(
-    meta 
+    meta
 
     version authority identifier
 );
 
 my @class_mop_class_methods = qw(
     meta
-    
-    initialize reinitialize create 
-    
+
+    initialize reinitialize create
+
     create_anon_class is_anon_class
-    
+
     instance_metaclass get_meta_instance
     new_object clone_object
     construct_instance construct_class_instance clone_instance
     check_metaclass_compatability
-    
+
     attribute_metaclass method_metaclass
-    
+
     superclasses class_precedence_list
-    
+
     has_method get_method add_method remove_method alias_method
-    get_method_list get_method_map compute_all_applicable_methods 
-       find_method_by_name find_all_methods_by_name find_next_method_by_name
-    
-       add_before_method_modifier add_after_method_modifier add_around_method_modifier
+    get_method_list get_method_map compute_all_applicable_methods
+        find_method_by_name find_all_methods_by_name find_next_method_by_name
+
+        add_before_method_modifier add_after_method_modifier add_around_method_modifier
 
     has_attribute get_attribute add_attribute remove_attribute
     get_attribute_list get_attribute_map compute_all_applicable_attributes find_attribute_by_name
-    
-    is_mutable is_immutable make_immutable
-    
+
+    is_mutable is_immutable make_mutable make_immutable
+
     DESTROY
 );
-    
-# check the class ...    
-    
+
+# check the class ...
+
 is_deeply([ sort @class_mop_class_methods ], [ sort $class_mop_class_meta->get_method_list ], '... got the correct method list for class');
 
 foreach my $method_name (@class_mop_class_methods) {
     ok($class_mop_class_meta->has_method($method_name), '... Class::MOP::Class->has_method(' . $method_name . ')');
     {
         no strict 'refs';
-        is($class_mop_class_meta->get_method($method_name)->body, 
+        is($class_mop_class_meta->get_method($method_name)->body,
            \&{'Class::MOP::Class::' . $method_name},
-           '... Class::MOP::Class->get_method(' . $method_name . ') == &Class::MOP::Class::' . $method_name);        
+           '... Class::MOP::Class->get_method(' . $method_name . ') == &Class::MOP::Class::' . $method_name);
     }
 }
 
@@ -99,9 +99,9 @@ foreach my $method_name (@class_mop_package_methods) {
     ok($class_mop_package_meta->has_method($method_name), '... Class::MOP::Package->has_method(' . $method_name . ')');
     {
         no strict 'refs';
-        is($class_mop_package_meta->get_method($method_name)->body, 
+        is($class_mop_package_meta->get_method($method_name)->body,
            \&{'Class::MOP::Package::' . $method_name},
-           '... Class::MOP::Package->get_method(' . $method_name . ') == &Class::MOP::Package::' . $method_name);        
+           '... Class::MOP::Package->get_method(' . $method_name . ') == &Class::MOP::Package::' . $method_name);
     }
 }
 
@@ -113,9 +113,9 @@ foreach my $method_name (@class_mop_module_methods) {
     ok($class_mop_module_meta->has_method($method_name), '... Class::MOP::Module->has_method(' . $method_name . ')');
     {
         no strict 'refs';
-        is($class_mop_module_meta->get_method($method_name)->body, 
+        is($class_mop_module_meta->get_method($method_name)->body,
            \&{'Class::MOP::Module::' . $method_name},
-           '... Class::MOP::Module->get_method(' . $method_name . ') == &Class::MOP::Module::' . $method_name);        
+           '... Class::MOP::Module->get_method(' . $method_name . ') == &Class::MOP::Module::' . $method_name);
     }
 }
 
@@ -128,27 +128,27 @@ foreach my $non_method_name (qw(
     subname
     svref_2object
     )) {
-    ok(!$class_mop_class_meta->has_method($non_method_name), '... NOT Class::MOP::Class->has_method(' . $non_method_name . ')');        
+    ok(!$class_mop_class_meta->has_method($non_method_name), '... NOT Class::MOP::Class->has_method(' . $non_method_name . ')');
 }
 
 # check for the right attributes
 
 my @class_mop_package_attributes = (
-    '$!package', 
+    '$!package',
     '%!namespace',
 );
 
 my @class_mop_module_attributes = (
-    '$!version', 
+    '$!version',
     '$!authority'
 );
 
 my @class_mop_class_attributes = (
     '@!superclasses',
-    '%!methods', 
-    '%!attributes', 
-    '$!attribute_metaclass', 
-    '$!method_metaclass', 
+    '%!methods',
+    '%!attributes',
+    '$!attribute_metaclass',
+    '$!method_metaclass',
     '$!instance_metaclass'
 );
 
@@ -158,15 +158,15 @@ is_deeply(
     [ sort @class_mop_class_attributes ],
     [ sort $class_mop_class_meta->get_attribute_list ],
     '... got the right list of attributes');
-    
+
 is_deeply(
     [ sort @class_mop_class_attributes ],
     [ sort keys %{$class_mop_class_meta->get_attribute_map} ],
-    '... got the right list of attributes');    
+    '... got the right list of attributes');
 
 foreach my $attribute_name (@class_mop_class_attributes) {
-    ok($class_mop_class_meta->has_attribute($attribute_name), '... Class::MOP::Class->has_attribute(' . $attribute_name . ')');        
-    isa_ok($class_mop_class_meta->get_attribute($attribute_name), 'Class::MOP::Attribute');            
+    ok($class_mop_class_meta->has_attribute($attribute_name), '... Class::MOP::Class->has_attribute(' . $attribute_name . ')');
+    isa_ok($class_mop_class_meta->get_attribute($attribute_name), 'Class::MOP::Attribute');
 }
 
 # check module
@@ -175,32 +175,32 @@ is_deeply(
     [ sort @class_mop_package_attributes ],
     [ sort $class_mop_package_meta->get_attribute_list ],
     '... got the right list of attributes');
-    
+
 is_deeply(
     [ sort @class_mop_package_attributes ],
     [ sort keys %{$class_mop_package_meta->get_attribute_map} ],
-    '... got the right list of attributes');    
+    '... got the right list of attributes');
 
 foreach my $attribute_name (@class_mop_package_attributes) {
-    ok($class_mop_package_meta->has_attribute($attribute_name), '... Class::MOP::Package->has_attribute(' . $attribute_name . ')');        
-    isa_ok($class_mop_package_meta->get_attribute($attribute_name), 'Class::MOP::Attribute');            
+    ok($class_mop_package_meta->has_attribute($attribute_name), '... Class::MOP::Package->has_attribute(' . $attribute_name . ')');
+    isa_ok($class_mop_package_meta->get_attribute($attribute_name), 'Class::MOP::Attribute');
 }
 
-# check package 
+# check package
 
 is_deeply(
     [ sort @class_mop_module_attributes ],
     [ sort $class_mop_module_meta->get_attribute_list ],
     '... got the right list of attributes');
-    
+
 is_deeply(
     [ sort @class_mop_module_attributes ],
     [ sort keys %{$class_mop_module_meta->get_attribute_map} ],
-    '... got the right list of attributes');    
+    '... got the right list of attributes');
 
 foreach my $attribute_name (@class_mop_module_attributes) {
-    ok($class_mop_module_meta->has_attribute($attribute_name), '... Class::MOP::Module->has_attribute(' . $attribute_name . ')');        
-    isa_ok($class_mop_module_meta->get_attribute($attribute_name), 'Class::MOP::Attribute');            
+    ok($class_mop_module_meta->has_attribute($attribute_name), '... Class::MOP::Module->has_attribute(' . $attribute_name . ')');
+    isa_ok($class_mop_module_meta->get_attribute($attribute_name), 'Class::MOP::Attribute');
 }
 
 ## check the attributes themselves
@@ -216,49 +216,49 @@ is($class_mop_package_meta->get_attribute('$!package')->init_arg, 'package', '..
 # ... class
 
 ok($class_mop_class_meta->get_attribute('%!attributes')->has_reader, '... Class::MOP::Class %!attributes has a reader');
-is_deeply($class_mop_class_meta->get_attribute('%!attributes')->reader, 
-   { 'get_attribute_map' => \&Class::MOP::Class::get_attribute_map }, 
+is_deeply($class_mop_class_meta->get_attribute('%!attributes')->reader,
+   { 'get_attribute_map' => \&Class::MOP::Class::get_attribute_map },
    '... Class::MOP::Class %!attributes\'s a reader is &get_attribute_map');
-   
+
 ok($class_mop_class_meta->get_attribute('%!attributes')->has_init_arg, '... Class::MOP::Class %!attributes has a init_arg');
-is($class_mop_class_meta->get_attribute('%!attributes')->init_arg, 
-  'attributes', 
-  '... Class::MOP::Class %!attributes\'s a init_arg is attributes');   
-  
+is($class_mop_class_meta->get_attribute('%!attributes')->init_arg,
+  'attributes',
+  '... Class::MOP::Class %!attributes\'s a init_arg is attributes');
+
 ok($class_mop_class_meta->get_attribute('%!attributes')->has_default, '... Class::MOP::Class %!attributes has a default');
-is_deeply($class_mop_class_meta->get_attribute('%!attributes')->default('Foo'), 
-         {}, 
-         '... Class::MOP::Class %!attributes\'s a default of {}');  
+is_deeply($class_mop_class_meta->get_attribute('%!attributes')->default('Foo'),
+         {},
+         '... Class::MOP::Class %!attributes\'s a default of {}');
 
 ok($class_mop_class_meta->get_attribute('$!attribute_metaclass')->has_reader, '... Class::MOP::Class $!attribute_metaclass has a reader');
-is_deeply($class_mop_class_meta->get_attribute('$!attribute_metaclass')->reader, 
-   { 'attribute_metaclass' => \&Class::MOP::Class::attribute_metaclass }, 
+is_deeply($class_mop_class_meta->get_attribute('$!attribute_metaclass')->reader,
+   { 'attribute_metaclass' => \&Class::MOP::Class::attribute_metaclass },
   '... Class::MOP::Class $!attribute_metaclass\'s a reader is &attribute_metaclass');
-  
+
 ok($class_mop_class_meta->get_attribute('$!attribute_metaclass')->has_init_arg, '... Class::MOP::Class $!attribute_metaclass has a init_arg');
-is($class_mop_class_meta->get_attribute('$!attribute_metaclass')->init_arg, 
-   'attribute_metaclass', 
-   '... Class::MOP::Class $!attribute_metaclass\'s a init_arg is attribute_metaclass');  
-   
+is($class_mop_class_meta->get_attribute('$!attribute_metaclass')->init_arg,
+   'attribute_metaclass',
+   '... Class::MOP::Class $!attribute_metaclass\'s a init_arg is attribute_metaclass');
+
 ok($class_mop_class_meta->get_attribute('$!attribute_metaclass')->has_default, '... Class::MOP::Class $!attribute_metaclass has a default');
-is($class_mop_class_meta->get_attribute('$!attribute_metaclass')->default, 
-  'Class::MOP::Attribute', 
-  '... Class::MOP::Class $!attribute_metaclass\'s a default is Class::MOP:::Attribute');   
-  
+is($class_mop_class_meta->get_attribute('$!attribute_metaclass')->default,
+  'Class::MOP::Attribute',
+  '... Class::MOP::Class $!attribute_metaclass\'s a default is Class::MOP:::Attribute');
+
 ok($class_mop_class_meta->get_attribute('$!method_metaclass')->has_reader, '... Class::MOP::Class $!method_metaclass has a reader');
-is_deeply($class_mop_class_meta->get_attribute('$!method_metaclass')->reader, 
+is_deeply($class_mop_class_meta->get_attribute('$!method_metaclass')->reader,
    { 'method_metaclass' => \&Class::MOP::Class::method_metaclass },
-   '... Class::MOP::Class $!method_metaclass\'s a reader is &method_metaclass');  
-   
+   '... Class::MOP::Class $!method_metaclass\'s a reader is &method_metaclass');
+
 ok($class_mop_class_meta->get_attribute('$!method_metaclass')->has_init_arg, '... Class::MOP::Class $!method_metaclass has a init_arg');
-is($class_mop_class_meta->get_attribute('$!method_metaclass')->init_arg, 
-  'method_metaclass', 
-  '... Class::MOP::Class $:method_metaclass\'s init_arg is method_metaclass');   
-  
+is($class_mop_class_meta->get_attribute('$!method_metaclass')->init_arg,
+  'method_metaclass',
+  '... Class::MOP::Class $:method_metaclass\'s init_arg is method_metaclass');
+
 ok($class_mop_class_meta->get_attribute('$!method_metaclass')->has_default, '... Class::MOP::Class $!method_metaclass has a default');
-is($class_mop_class_meta->get_attribute('$!method_metaclass')->default, 
-   'Class::MOP::Method', 
-  '... Class::MOP::Class $!method_metaclass\'s a default is Class::MOP:::Method');  
+is($class_mop_class_meta->get_attribute('$!method_metaclass')->default,
+   'Class::MOP::Method',
+  '... Class::MOP::Class $!method_metaclass\'s a default is Class::MOP:::Method');
 
 # check the values of some of the methods
 
@@ -266,23 +266,23 @@ is($class_mop_class_meta->name, 'Class::MOP::Class', '... Class::MOP::Class->nam
 is($class_mop_class_meta->version, $Class::MOP::Class::VERSION, '... Class::MOP::Class->version');
 
 ok($class_mop_class_meta->has_package_symbol('$VERSION'), '... Class::MOP::Class->has_package_symbol($VERSION)');
-is(${$class_mop_class_meta->get_package_symbol('$VERSION')}, 
-   $Class::MOP::Class::VERSION, 
+is(${$class_mop_class_meta->get_package_symbol('$VERSION')},
+   $Class::MOP::Class::VERSION,
    '... Class::MOP::Class->get_package_symbol($VERSION)');
 
 is_deeply(
-    [ $class_mop_class_meta->superclasses ], 
-    [ qw/Class::MOP::Module/ ], 
+    [ $class_mop_class_meta->superclasses ],
+    [ qw/Class::MOP::Module/ ],
     '... Class::MOP::Class->superclasses == [ Class::MOP::Module ]');
-    
+
 is_deeply(
-    [ $class_mop_class_meta->class_precedence_list ], 
+    [ $class_mop_class_meta->class_precedence_list ],
     [ qw/
         Class::MOP::Class
         Class::MOP::Module
-        Class::MOP::Package     
-        Class::MOP::Object           
-    / ], 
+        Class::MOP::Package
+        Class::MOP::Object
+    / ],
     '... Class::MOP::Class->class_precedence_list == [ Class::MOP::Class Class::MOP::Module Class::MOP::Package ]');
 
 is($class_mop_class_meta->attribute_metaclass, 'Class::MOP::Attribute', '... got the right value for attribute_metaclass');
index 5b1a1ca..b0294be 100644 (file)
@@ -12,59 +12,59 @@ BEGIN {
 
 {
     package Foo;
-    
+
     use strict;
     use warnings;
     use metaclass;
-    
+
     __PACKAGE__->meta->add_attribute('bar');
-    
+
     package Bar;
-    
+
     use strict;
     use warnings;
     use metaclass;
-    
+
     __PACKAGE__->meta->superclasses('Foo');
 
-    __PACKAGE__->meta->add_attribute('baz');    
-    
+    __PACKAGE__->meta->add_attribute('baz');
+
     package Baz;
-    
+
     use strict;
     use warnings;
     use metaclass;
-    
+
     __PACKAGE__->meta->superclasses('Bar');
 
-    __PACKAGE__->meta->add_attribute('bah');    
+    __PACKAGE__->meta->add_attribute('bah');
 }
 
 {
     my $meta = Foo->meta;
     is($meta->name, 'Foo', '... checking the Foo metaclass');
-    
+
     ok($meta->is_mutable, '... our class is mutable');
-    ok(!$meta->is_immutable, '... our class is not immutable');    
+    ok(!$meta->is_immutable, '... our class is not immutable');
 
     lives_ok {
         $meta->make_immutable();
     } '... changed Foo to be immutable';
-    
+
     ok(!$meta->make_immutable, '... make immutable now returns nothing');
-    
+
     ok(!$meta->is_mutable, '... our class is no longer mutable');
-    ok($meta->is_immutable, '... our class is now immutable');    
+    ok($meta->is_immutable, '... our class is now immutable');
 
     isa_ok($meta, 'Class::MOP::Class');
-    
+
     dies_ok { $meta->add_method()    } '... exception thrown as expected';
     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
     dies_ok { $meta->remove_method() } '... exception thrown as expected';
-    
+
     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
-                        
+
     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 
@@ -74,23 +74,23 @@ BEGIN {
     } '... got the superclasses okay';
 
     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
-    
+
     my $meta_instance;
     lives_ok {
         $meta_instance = $meta->get_meta_instance;
     } '... got the meta instance okay';
     isa_ok($meta_instance, 'Class::MOP::Instance');
     is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
-    
+
     my @cpl;
     lives_ok {
         @cpl = $meta->class_precedence_list;
-    } '... got the class precedence list okay';    
+    } '... got the class precedence list okay';
     is_deeply(
     \@cpl,
     [ 'Foo' ],
     '... we just have ourselves in the class precedence list');
-    
+
     my @attributes;
     lives_ok {
         @attributes = $meta->compute_all_applicable_attributes;
@@ -103,29 +103,29 @@ BEGIN {
 
 {
     my $meta = Bar->meta;
-    is($meta->name, 'Bar', '... checking the Bar metaclass');    
-    
+    is($meta->name, 'Bar', '... checking the Bar metaclass');
+
     ok($meta->is_mutable, '... our class is mutable');
-    ok(!$meta->is_immutable, '... our class is not immutable');    
+    ok(!$meta->is_immutable, '... our class is not immutable');
 
     lives_ok {
         $meta->make_immutable();
     } '... changed Bar to be immutable';
-    
+
     ok(!$meta->make_immutable, '... make immutable now returns nothing');
-    
+
     ok(!$meta->is_mutable, '... our class is no longer mutable');
-    ok($meta->is_immutable, '... our class is now immutable');    
+    ok($meta->is_immutable, '... our class is now immutable');
 
     isa_ok($meta, 'Class::MOP::Class');
-    
+
     dies_ok { $meta->add_method()    } '... exception thrown as expected';
     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
     dies_ok { $meta->remove_method() } '... exception thrown as expected';
-    
+
     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
-                        
+
     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 
@@ -135,23 +135,23 @@ BEGIN {
     } '... got the superclasses okay';
 
     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
-    
+
     my $meta_instance;
     lives_ok {
         $meta_instance = $meta->get_meta_instance;
     } '... got the meta instance okay';
     isa_ok($meta_instance, 'Class::MOP::Instance');
-    is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');    
-    
+    is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
+
     my @cpl;
     lives_ok {
         @cpl = $meta->class_precedence_list;
-    } '... got the class precedence list okay';    
+    } '... got the class precedence list okay';
     is_deeply(
     \@cpl,
     [ 'Bar', 'Foo'],
     '... we just have ourselves in the class precedence list');
-    
+
     my @attributes;
     lives_ok {
         @attributes = $meta->compute_all_applicable_attributes;
@@ -164,29 +164,29 @@ BEGIN {
 
 {
     my $meta = Baz->meta;
-    is($meta->name, 'Baz', '... checking the Baz metaclass');    
-    
+    is($meta->name, 'Baz', '... checking the Baz metaclass');
+
     ok($meta->is_mutable, '... our class is mutable');
-    ok(!$meta->is_immutable, '... our class is not immutable');    
+    ok(!$meta->is_immutable, '... our class is not immutable');
 
     lives_ok {
         $meta->make_immutable();
     } '... changed Baz to be immutable';
-    
+
     ok(!$meta->make_immutable, '... make immutable now returns nothing');
-    
+
     ok(!$meta->is_mutable, '... our class is no longer mutable');
-    ok($meta->is_immutable, '... our class is now immutable');    
+    ok($meta->is_immutable, '... our class is now immutable');
 
     isa_ok($meta, 'Class::MOP::Class');
-    
+
     dies_ok { $meta->add_method()    } '... exception thrown as expected';
     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
     dies_ok { $meta->remove_method() } '... exception thrown as expected';
-    
+
     dies_ok { $meta->add_attribute()    } '... exception thrown as expected';
     dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
-                        
+
     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
 
@@ -196,23 +196,23 @@ BEGIN {
     } '... got the superclasses okay';
 
     dies_ok { $meta->superclasses([ 'UNIVERSAL' ]) } '... but could not set the superclasses okay';
-    
+
     my $meta_instance;
     lives_ok {
         $meta_instance = $meta->get_meta_instance;
     } '... got the meta instance okay';
     isa_ok($meta_instance, 'Class::MOP::Instance');
-    is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');    
-    
+    is($meta_instance, $meta->get_meta_instance, '... and we know it is cached');
+
     my @cpl;
     lives_ok {
         @cpl = $meta->class_precedence_list;
-    } '... got the class precedence list okay';    
+    } '... got the class precedence list okay';
     is_deeply(
     \@cpl,
     [ 'Baz', 'Bar', 'Foo'],
     '... we just have ourselves in the class precedence list');
-    
+
     my @attributes;
     lives_ok {
         @attributes = $meta->compute_all_applicable_attributes;
diff --git a/t/073_make_mutable.t b/t/073_make_mutable.t
new file mode 100644 (file)
index 0000000..118bcaf
--- /dev/null
@@ -0,0 +1,214 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 101;
+use Test::Exception;
+
+use Scalar::Util;
+
+BEGIN {
+    use_ok('Class::MOP');
+}
+
+{
+    package Foo;
+
+    use strict;
+    use warnings;
+    use metaclass;
+
+    __PACKAGE__->meta->add_attribute('bar');
+
+    package Bar;
+
+    use strict;
+    use warnings;
+    use metaclass;
+
+    __PACKAGE__->meta->superclasses('Foo');
+
+    __PACKAGE__->meta->add_attribute('baz');
+
+    package Baz;
+
+    use strict;
+    use warnings;
+    use metaclass;
+
+    __PACKAGE__->meta->superclasses('Bar');
+
+    __PACKAGE__->meta->add_attribute('bah');
+}
+
+{
+    my $meta = Baz->meta;
+    is($meta->name, 'Baz', '... checking the Baz metaclass');
+    my @orig_keys = sort keys %$meta;
+
+    lives_ok {$meta->make_immutable() } '... changed Baz to be immutable';
+    ok(!$meta->is_mutable,              '... our class is no longer mutable');
+    ok($meta->is_immutable,             '... our class is now immutable');
+    ok(!$meta->make_immutable,          '... make immutable now returns nothing');
+
+    lives_ok { $meta->make_mutable() }  '... changed Baz to be mutable';
+    ok($meta->is_mutable,               '... our class is mutable');
+    ok(!$meta->is_immutable,            '... our class is not immutable');
+    ok(!$meta->make_mutable,            '... make mutable now returns nothing');
+
+    my @new_keys = sort keys %$meta;
+    is_deeply(\@orig_keys, \@new_keys, '... no straneous hashkeys');
+
+    isa_ok($meta, 'Class::MOP::Class', '... Baz->meta isa Class::MOP::Class');
+
+    ok( $meta->add_method('xyz', sub{'xxx'}), '... added method');
+    is( Baz->xyz, 'xxx',                      '... method xyz works');
+    ok( $meta->alias_method('zxy',sub{'xxx'}),'... aliased method');
+    is( Baz->zxy, 'xxx',                      '... method zxy works');
+    ok( $meta->remove_method('xyz'),          '... removed method');
+    ok( $meta->remove_method('zxy'),          '... removed aliased method');
+
+    ok($meta->add_attribute('fickle', accessor => 'fickle'), '... added attribute');
+    ok(Baz->can('fickle'),                '... Baz can fickle');
+    ok($meta->remove_attribute('fickle'), '... removed attribute');
+
+    my $reef = \ 'reef';
+    ok($meta->add_package_symbol('$ref', $reef),      '... added package symbol');
+    is($meta->get_package_symbol('$ref'), $reef,      '... values match');
+    lives_ok { $meta->remove_package_symbol('$ref') } '... removed it';
+    isnt($meta->get_package_symbol('$ref'), $reef,    '... values match');
+
+    ok( my @supers = $meta->superclasses,       '... got the superclasses okay');
+    ok( $meta->superclasses('Foo'),             '... set the superclasses');
+    is_deeply(['Foo'], [$meta->superclasses],   '... set the superclasses okay');
+    ok( $meta->superclasses( @supers ),         '... reset superclasses');
+    is_deeply([@supers], [$meta->superclasses], '... reset the superclasses okay');
+
+    ok( $meta->$_  , "... ${_} works")
+      for qw(get_meta_instance       compute_all_applicable_attributes
+             class_precedence_list  get_method_map );
+}
+
+{
+    my $meta = Baz->meta;
+
+    lives_ok { $meta->make_immutable() } 'Changed Baz to be immutable';
+    lives_ok { $meta->make_mutable() }   '... changed Baz to be mutable';
+    lives_ok { $meta->make_immutable() } '... changed Baz to be immutable';
+
+    dies_ok{ $meta->add_method('xyz', sub{'xxx'})  } '... exception thrown as expected';
+    dies_ok{ $meta->alias_method('zxy',sub{'xxx'}) } '... exception thrown as expected';
+    dies_ok{ $meta->remove_method('zxy')           } '... exception thrown as expected';
+
+    dies_ok {
+      $meta->add_attribute('fickle', accessor => 'fickle')
+    }  '... exception thrown as expected';
+    dies_ok { $meta->remove_attribute('fickle') } '... exception thrown as expected';
+
+    my $reef = \ 'reef';
+    dies_ok { $meta->add_package_symbol('$ref', $reef) } '... exception thrown as expected';
+    dies_ok { $meta->remove_package_symbol('$ref')     } '... exception thrown as expected';
+
+    ok( my @supers = $meta->superclasses,  '... got the superclasses okay');
+    dies_ok { $meta->superclasses('Foo') } '... set the superclasses';
+
+    ok( $meta->$_  , "... ${_} works")
+      for qw(get_meta_instance       compute_all_applicable_attributes
+             class_precedence_list  get_method_map );
+}
+
+
+
+{
+
+    my $meta = Baz->meta->create_anon_class(superclasses => ['Baz']);
+    my @orig_keys  = sort keys %$meta;
+    my @orig_meths = sort $meta->compute_all_applicable_methods;
+    ok($meta->is_anon_class,                  'We have an anon metaclass');
+    lives_ok {$meta->make_immutable(
+                                    inline_accessor    => 1,
+                                    inline_destructor  => 0,
+                                    inline_constructor => 1,
+                                   )
+            } '... changed class to be immutable';
+    ok(!$meta->is_mutable,                    '... our class is no longer mutable');
+    ok($meta->is_immutable,                   '... our class is now immutable');
+    ok(!$meta->make_immutable,                '... make immutable now returns nothing');
+
+    lives_ok { $meta->make_mutable }  '... changed Baz to be mutable';
+    ok($meta->is_mutable,             '... our class is mutable');
+    ok(!$meta->is_immutable,          '... our class is not immutable');
+    ok(!$meta->make_mutable,          '... make mutable now returns nothing');
+    ok($meta->is_anon_class,          '... still marked as an anon class');
+    my $instance = $meta->new_object;
+
+    my @new_keys  = sort keys %$meta;
+    my @new_meths = sort $meta->compute_all_applicable_methods;
+    is_deeply(\@orig_keys, \@new_keys, '... no straneous hashkeys');
+    is_deeply(\@orig_meths, \@new_meths, '... no straneous methods');
+
+    isa_ok($meta, 'Class::MOP::Class', '... Anon class isa Class::MOP::Class');
+
+    ok( $meta->add_method('xyz', sub{'xxx'}), '... added method');
+    is( $instance->xyz , 'xxx',               '... method xyz works');
+    ok( $meta->alias_method('zxy',sub{'xxx'}),'... aliased method');
+    is( $instance->zxy, 'xxx',                '... method zxy works');
+    ok( $meta->remove_method('xyz'),          '... removed method');
+    ok( $meta->remove_method('zxy'),          '... removed aliased method');
+
+    ok($meta->add_attribute('fickle', accessor => 'fickle'), '... added attribute');
+    ok($instance->can('fickle'),          '... instance can fickle');
+    ok($meta->remove_attribute('fickle'), '... removed attribute');
+
+    my $reef = \ 'reef';
+    ok($meta->add_package_symbol('$ref', $reef),      '... added package symbol');
+    is($meta->get_package_symbol('$ref'), $reef,      '... values match');
+    lives_ok { $meta->remove_package_symbol('$ref') } '... removed it';
+    isnt($meta->get_package_symbol('$ref'), $reef,    '... values match');
+
+    ok( my @supers = $meta->superclasses,       '... got the superclasses okay');
+    ok( $meta->superclasses('Foo'),             '... set the superclasses');
+    is_deeply(['Foo'], [$meta->superclasses],   '... set the superclasses okay');
+    ok( $meta->superclasses( @supers ),         '... reset superclasses');
+    is_deeply([@supers], [$meta->superclasses], '... reset the superclasses okay');
+
+    ok( $meta->$_  , "... ${_} works")
+      for qw(get_meta_instance       compute_all_applicable_attributes
+             class_precedence_list  get_method_map );
+};
+
+
+#rerun the same tests on an anon class.. just cause we can.
+{
+    my $meta = Baz->meta->create_anon_class(superclasses => ['Baz']);
+
+    lives_ok {$meta->make_immutable(
+                                    inline_accessor    => 1,
+                                    inline_destructor  => 0,
+                                    inline_constructor => 1,
+                                   )
+            } '... changed class to be immutable';
+    lives_ok { $meta->make_mutable() }   '... changed class to be mutable';
+    lives_ok {$meta->make_immutable  } '... changed class to be immutable';
+
+    dies_ok{ $meta->add_method('xyz', sub{'xxx'})  } '... exception thrown as expected';
+    dies_ok{ $meta->alias_method('zxy',sub{'xxx'}) } '... exception thrown as expected';
+    dies_ok{ $meta->remove_method('zxy')           } '... exception thrown as expected';
+
+    dies_ok {
+      $meta->add_attribute('fickle', accessor => 'fickle')
+    }  '... exception thrown as expected';
+    dies_ok { $meta->remove_attribute('fickle') } '... exception thrown as expected';
+
+    my $reef = \ 'reef';
+    dies_ok { $meta->add_package_symbol('$ref', $reef) } '... exception thrown as expected';
+    dies_ok { $meta->remove_package_symbol('$ref')     } '... exception thrown as expected';
+
+    ok( my @supers = $meta->superclasses,  '... got the superclasses okay');
+    dies_ok { $meta->superclasses('Foo') } '... set the superclasses';
+
+    ok( $meta->$_  , "... ${_} works")
+      for qw(get_meta_instance       compute_all_applicable_attributes
+             class_precedence_list  get_method_map );
+}