From: Stevan Little Date: Thu, 6 Jul 2006 02:58:10 +0000 (+0000) Subject: foo X-Git-Tag: 0_33~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=373a16aed9249f13e466532ef9a840b92a61f173;p=gitmo%2FClass-MOP.git foo --- diff --git a/Changes b/Changes index 772d9ed..2c661b3 100644 --- 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 diff --git a/MANIFEST b/MANIFEST index 40a3e03..249f5cf 100644 --- 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 diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index aa78547..9b06820 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -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 ... diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index ceec1b4..8625e36 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -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. diff --git a/lib/Class/MOP/Class/Immutable.pm b/lib/Class/MOP/Class/Immutable.pm index 172b0b4..0a95028 100644 --- a/lib/Class/MOP/Class/Immutable.pm +++ b/lib/Class/MOP/Class/Immutable.pm @@ -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 +=item B + =back =head2 Methods which will die if you touch them. @@ -237,8 +238,6 @@ to this method, which =item B -=item B - =item B =item B diff --git a/t/070_immutable_metaclass.t b/t/070_immutable_metaclass.t index 40c935c..d057136 100644 --- a/t/070_immutable_metaclass.t +++ b/t/070_immutable_metaclass.t @@ -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 index 0000000..7624b6b --- /dev/null +++ b/t/071_immutable_w_custom_metaclass.t @@ -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'; +} + + +