* Class::MOP::Class
- Immutability can now be undone,
added make_mutable + tests + docs (groditi)
+ - Massive changes to the way Immutable is done
+ for details see comments next to make_immutable
+ This fixes a bug where custom metaclasses broke
+ when made immutable. We are now keeping one immutable
+ metaclass instance per metaclass instead of just one
+ to prevent isa hierarchy corruption. Memory use will go
+ up, but I suspect it will be neglible.
+ - New tests added for this behavior. (groditi)
0.38 Thurs. May 31, 2007
~~ More documentation updates ~~
use Class::MOP::Method::Wrapped;
use Carp 'confess';
-use Scalar::Util 'blessed', 'reftype', 'weaken';
+use Scalar::Util 'blessed', 'reftype', 'weaken', 'refaddr';
use Sub::Name 'subname';
use B 'svref_2object';
sub is_mutable { 1 }
sub is_immutable { 0 }
+#Why I changed this (groditi)
+# - One Metaclass may have many Classes through many Metaclass instances
+# - One Metaclass should only have one Immutable Metaclass instance
+# - Each Class may have different Immutabilizing options
+# - Therefore each Metaclass instance may have different Immutabilizing options
+# - We need to store one Immutable Metaclass instance per Metaclass
+# - We need to store one set of Immutable Metaclass options per Class
+# - Upon make_mutable we may delete the Immutabilizing options
+# - We could clean the immutable Metaclass instance when there is no more
+# immutable Classes with this Metaclass, but we can also keep it in case
+# another class with this same Metaclass becomes immutable. It is a case
+# of trading of storing an instance to avoid unnecessary instantiations of
+# Immutable Metaclass instances. You may view this as a memory leak, however
+# Because we have few Metaclasses, in practice it seems acceptable
+# - To allow Immutable Metaclass instances to be cleaned up we could weaken
+# the reference stored in $IMMUTABLE_METACLASSES{$class} and ||= should DWIM
+
{
# NOTE:
# the immutable version of a
# really class-level data so
# we don't want to regenerate
# it any more than we need to
- my $IMMUTABLE_METACLASS;
+ my %IMMUTABLE_METACLASSES;
my %IMMUTABLE_OPTIONS;
sub make_immutable {
my $self = shift;
- %IMMUTABLE_OPTIONS = @_;
+ my %options = @_;
+ my $class = blessed $self || $self;;
- $IMMUTABLE_METACLASS ||= Class::MOP::Immutable->new($self, {
+ $IMMUTABLE_METACLASSES{$class} ||= Class::MOP::Immutable->new($self, {
read_only => [qw/superclasses/],
cannot_call => [qw/
add_method
}
});
- $IMMUTABLE_METACLASS->make_metaclass_immutable($self, %IMMUTABLE_OPTIONS);
+ $IMMUTABLE_METACLASSES{$class}->make_metaclass_immutable($self, %options);
+ $IMMUTABLE_OPTIONS{refaddr $self} =
+ { %options, IMMUTABLE_METACLASS => $IMMUTABLE_METACLASSES{$class} };
+
+ if( exists $options{debug} && $options{debug} ){
+ print STDERR "# of Metaclass options: ", keys %IMMUTABLE_OPTIONS;
+ print STDERR "# of Immutable metaclasses: ", keys %IMMUTABLE_METACLASSES;
+ }
}
sub make_mutable{
my $self = shift;
return if $self->is_mutable;
- $IMMUTABLE_METACLASS->make_metaclass_mutable($self, %IMMUTABLE_OPTIONS);
+ my $options = delete $IMMUTABLE_OPTIONS{refaddr $self};
+ my $immutable_metaclass = delete $options->{IMMUTABLE_METACLASS};
+ $immutable_metaclass->make_metaclass_mutable($self, %$options);
}
}
if ($options{inline_constructor}) {
my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor';
-
$metaclass->add_method(
$options{constructor_name},
$constructor_class->new(
use strict;
use warnings;
-use Test::More tests => 2;
+use FindBin;
+use File::Spec::Functions;
+
+use Test::More tests => 10;
use Test::Exception;
+use Scalar::Util;
BEGIN {
use_ok('Class::MOP');
}
+use lib catdir($FindBin::Bin, 'lib');
+
{
- package Meta::Baz;
+ package Foo;
+
use strict;
use warnings;
- use base 'Class::MOP::Class';
-}
+ use metaclass;
+
+ __PACKAGE__->meta->make_immutable;
-{
package Bar;
-
+
use strict;
use warnings;
- use metaclass;
-
+ use metaclass;
+
__PACKAGE__->meta->make_immutable;
-
+
package Baz;
-
+
use strict;
use warnings;
- use metaclass 'Meta::Baz';
+ use metaclass 'MyMetaClass';
+
+ sub mymetaclass_attributes{
+ shift->meta->mymetaclass_attributes;
+ }
::lives_ok {
- Baz->meta->superclasses('Bar');
+ Baz->meta->superclasses('Bar');
} '... we survive the metaclass incompatability test';
}
-
-
+{
+ my $meta = Baz->meta;
+ is(Foo->meta->blessed, Bar->meta->blessed, 'Foo and Bar immutable metaclasses match');
+ is($meta->blessed, 'MyMetaClass', 'Baz->meta blessed as MyMetaClass');
+ ok(Baz->can('mymetaclass_attributes'), '... Baz can do method before immutable');
+ ok($meta->can('mymetaclass_attributes'), '... meta can do method before immutable');
+ $meta->make_immutable;
+ isa_ok($meta, 'MyMetaClass', 'Baz->meta');
+ ok(Baz->can('mymetaclass_attributes'), '... Baz can do method after imutable');
+ ok($meta->can('mymetaclass_attributes'), '... meta can do method after immutable');
+ isnt(Baz->meta->blessed, Bar->meta->blessed, 'Baz and Bar immutable metaclasses are different');
+}
is($meta->name, 'Baz', '... checking the Baz metaclass');
my @orig_keys = sort keys %$meta;
- lives_ok {$meta->make_immutable() } '... changed Baz to be immutable';
+ 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';
+ 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');
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;
+ my @orig_meths = sort { $a->{name} cmp $b->{name} }
+ $meta->compute_all_applicable_methods;
ok($meta->is_anon_class, 'We have an anon metaclass');
lives_ok {$meta->make_immutable(
inline_accessor => 1,
my $instance = $meta->new_object;
my @new_keys = sort keys %$meta;
- my @new_meths = sort $meta->compute_all_applicable_methods;
+ my @new_meths = sort { $a->{name} cmp $b->{name} }
+ $meta->compute_all_applicable_methods;
is_deeply(\@orig_keys, \@new_keys, '... no straneous hashkeys');
is_deeply(\@orig_meths, \@new_meths, '... no straneous methods');
use base 'Class::MOP::Class';
+sub mymetaclass_attributes{
+ my $self = shift;
+ return grep { $_->isa("MyMetaClass::Attribute") }
+ $self->compute_all_applicable_attributes;
+}
+
1;
projects / gitmo/Class-MOP.git / commitdiff