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
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
use Class::MOP::Class::Immutable;
-our $VERSION = '0.29_03';
+our $VERSION = '0.30';
## ----------------------------------------------------------------------------
## Setting up our environment ...
# 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;
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.
# 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' }
}
$meta_instance->inline_set_slot_value(
'$instance',
- $attr->name,
+ ("'" . $attr->name . "'"),
('$params{\'' . $attr->init_arg . '\'}' . (defined $default ? (' || ' . $default) : ''))
)
}
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;
=item B<make_immutable>
+=item B<get_mutable_metaclass_name>
+
=back
=head2 Methods which will die if you touch them.
=item B<alias_method>
-=item B<reinitialize>
-
=item B<remove_attribute>
=item B<remove_method>
use strict;
use warnings;
-use Test::More tests => 80;
+use Test::More tests => 77;
use Test::Exception;
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';
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';
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';
--- /dev/null
+#!/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';
+}
+
+
+