foo
Stevan Little [Thu, 6 Jul 2006 02:58:10 +0000 (02:58 +0000)]
Changes
MANIFEST
lib/Class/MOP.pm
lib/Class/MOP/Class.pm
lib/Class/MOP/Class/Immutable.pm
t/070_immutable_metaclass.t
t/071_immutable_w_custom_metaclass.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 772d9ed..2c661b3 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,15 +1,19 @@
 Revision history for Perl extension Class-MOP.
 
-0.29_03 Wed. July 5, 2006
-    ++ DEVELOPER RELEASE ++
+0.30 Wed. July 5, 2006
+    ---------------------------------------
+    This is the first version of Class::MOP 
+    to introduce the immutable features which
+    will be used for optimizating the MOP. 
+    This support should still be considered
+    experimental, but moving towards stability.
+    ---------------------------------------
     
-    created the Class::MOP::Package and 
-    Class::MOP::Module classes to more 
-    closely conform to Perl 6's meta model
+    * Created Class::MOP::Class::Immutable  
     
-    created Class::MOP::Class::Immutable 
-    which can be used to "close" a class 
-    and then apply some optimizations
+    * Created the Class::MOP::Package and 
+      Class::MOP::Module classes to more 
+      closely conform to Perl 6's meta-model
 
     * Class::MOP::Class
       - now inherits from Class::MOP::Module
index 40a3e03..249f5cf 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -50,6 +50,7 @@ t/050_scala_style_mixin_composition.t
 t/060_instance.t
 t/061_instance_inline.t
 t/070_immutable_metaclass.t
+t/071_immutable_w_custom_metaclass.t
 t/080_meta_package.t
 t/100_BinaryTree_test.t
 t/101_InstanceCountingClass_test.t
index aa78547..9b06820 100644 (file)
@@ -13,7 +13,7 @@ use Class::MOP::Method;
 
 use Class::MOP::Class::Immutable;
 
-our $VERSION = '0.29_03';
+our $VERSION = '0.30';
 
 ## ----------------------------------------------------------------------------
 ## Setting up our environment ...
index ceec1b4..8625e36 100644 (file)
@@ -79,6 +79,17 @@ my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
         # annoyingly enough during global destruction)
         return $METAS{$package_name} 
             if exists $METAS{$package_name} && defined $METAS{$package_name};  
+
+        # NOTE:
+        # 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
+                            ? $class->get_mutable_metaclass_name()
+                            : blessed($class))
+                        : $class);
+
         $class = blessed($class) || $class;
         # now create the metaclass
         my $meta;
@@ -121,10 +132,19 @@ my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
 
         foreach my $class_name (@class_list) { 
             my $meta = $METAS{$class_name} || next;
-            ($self->isa(blessed($meta)))
+            
+            # NOTE:
+            # 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));                
+                                
+            ($self->isa($meta_type))
                 || confess $self->name . "->meta => (" . (blessed($self)) . ")" . 
                            " is not compatible with the " . 
-                           $class_name . "->meta => (" . (blessed($meta)) . ")";
+                           $class_name . "->meta => (" . ($meta_type)     . ")";
             # NOTE:
             # we also need to check that instance metaclasses
             # are compatabile in the same the class.
index 172b0b4..0a95028 100644 (file)
@@ -13,8 +13,6 @@ use base 'Class::MOP::Class';
 
 # methods which can *not* be called
 
-sub reinitialize { confess 'Cannot call method "reinitialize" on an immutable instance' }
-
 sub add_method    { confess 'Cannot call method "add_method" on an immutable instance'    }
 sub alias_method  { confess 'Cannot call method "alias_method" on an immutable instance'  }
 sub remove_method { confess 'Cannot call method "remove_method" on an immutable instance' }
@@ -125,7 +123,7 @@ sub _generate_slot_initializer {
     }
     $meta_instance->inline_set_slot_value(
         '$instance', 
-        $attr->name, 
+        ("'" . $attr->name . "'"), 
         ('$params{\'' . $attr->init_arg . '\'}' . (defined $default ? (' || ' . $default) : ''))
     )    
 }
@@ -135,6 +133,7 @@ sub _generate_slot_initializer {
 sub get_meta_instance                 {   (shift)->{'___get_meta_instance'}                  }
 sub class_precedence_list             { @{(shift)->{'___class_precedence_list'}}             }
 sub compute_all_applicable_attributes { @{(shift)->{'___compute_all_applicable_attributes'}} }
+sub get_mutable_metaclass_name        {   (shift)->{'___original_class'}                     }
 
 1;
 
@@ -223,6 +222,8 @@ to this method, which
 
 =item B<make_immutable>
 
+=item B<get_mutable_metaclass_name>
+
 =back
 
 =head2 Methods which will die if you touch them.
@@ -237,8 +238,6 @@ to this method, which
 
 =item B<alias_method>
 
-=item B<reinitialize>
-
 =item B<remove_attribute>
 
 =item B<remove_method>
index 40c935c..d057136 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 80;
+use Test::More tests => 77;
 use Test::Exception;
 
 BEGIN {
@@ -59,8 +59,6 @@ BEGIN {
 
     isa_ok($meta, 'Class::MOP::Class::Immutable');
     isa_ok($meta, 'Class::MOP::Class');
-
-    dies_ok { $meta->reinitialize() } '... exception thrown as expected';
     
     dies_ok { $meta->add_method()    } '... exception thrown as expected';
     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
@@ -123,8 +121,6 @@ BEGIN {
 
     isa_ok($meta, 'Class::MOP::Class::Immutable');
     isa_ok($meta, 'Class::MOP::Class');
-
-    dies_ok { $meta->reinitialize() } '... exception thrown as expected';
     
     dies_ok { $meta->add_method()    } '... exception thrown as expected';
     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
@@ -187,8 +183,6 @@ BEGIN {
 
     isa_ok($meta, 'Class::MOP::Class::Immutable');
     isa_ok($meta, 'Class::MOP::Class');
-
-    dies_ok { $meta->reinitialize() } '... exception thrown as expected';
     
     dies_ok { $meta->add_method()    } '... exception thrown as expected';
     dies_ok { $meta->alias_method()  } '... exception thrown as expected';
diff --git a/t/071_immutable_w_custom_metaclass.t b/t/071_immutable_w_custom_metaclass.t
new file mode 100644 (file)
index 0000000..7624b6b
--- /dev/null
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Class::MOP');
+}
+
+{
+    package Meta::Baz;
+    use strict;
+    use warnings;
+    use base 'Class::MOP::Class';
+}
+
+{
+    package Bar;
+    
+    use strict;
+    use warnings;
+    use metaclass;           
+    
+    __PACKAGE__->meta->make_immutable;
+    
+    package Baz;
+    
+    use strict;
+    use warnings;
+    use metaclass 'Meta::Baz';    
+
+    ::lives_ok {
+        Baz->meta->superclasses('Bar');    
+    } '... we survive the metaclass incompatability test';
+}
+
+
+