* Class::MOP::Class::Immutable
- added make_metaclass_mutable + docs (groditi)
- removed unused variable
+ - added create_immutable_transformer
+ necessary for sane overloading of immutable behavior
+ - tests for this (groditi)
* Class::MOP::Class
- Immutability can now be undone,
#Why I changed this (groditi)
# - One Metaclass may have many Classes through many Metaclass instances
-# - One Metaclass should only have one Immutable Metaclass instance
+# - One Metaclass should only have one Immutable Transformer 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
+# - We need to store one Immutable Transformer instance per Metaclass
+# - We need to store one set of Immutable Transformer 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
+# - We could clean the immutable Transformer instance when there is no more
+# immutable Classes of that type, 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
+# Immutable Transformers. 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
+# - To allow Immutable Transformers instances to be cleaned up we could weaken
+# the reference stored in $IMMUTABLE_TRANSFORMERS{$class} and ||= should DWIM
{
- # NOTE:
- # 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_METACLASSES;
+ my %IMMUTABLE_TRANSFORMERS;
my %IMMUTABLE_OPTIONS;
sub make_immutable {
my $self = shift;
my %options = @_;
- my $class = blessed $self || $self;;
-
- $IMMUTABLE_METACLASSES{$class} ||= Class::MOP::Immutable->new($self, {
- read_only => [qw/superclasses/],
- cannot_call => [qw/
- add_method
- alias_method
- remove_method
- add_attribute
- remove_attribute
- add_package_symbol
- remove_package_symbol
- /],
- memoize => {
- class_precedence_list => 'ARRAY',
- compute_all_applicable_attributes => 'ARRAY',
- get_meta_instance => 'SCALAR',
- get_method_map => 'SCALAR',
- }
- });
-
- $IMMUTABLE_METACLASSES{$class}->make_metaclass_immutable($self, %options);
+ my $class = blessed $self || $self;
+
+ $IMMUTABLE_TRANSFORMERS{$class} ||= $self->create_immutable_transformer;
+ my $transformer = $IMMUTABLE_TRANSFORMERS{$class};
+
+ $transformer->make_metaclass_immutable($self, %options);
$IMMUTABLE_OPTIONS{refaddr $self} =
- { %options, IMMUTABLE_METACLASS => $IMMUTABLE_METACLASSES{$class} };
+ { %options, IMMUTABLE_TRANSFORMER => $transformer };
if( exists $options{debug} && $options{debug} ){
- print STDERR "# of Metaclass options: ", keys %IMMUTABLE_OPTIONS;
- print STDERR "# of Immutable metaclasses: ", keys %IMMUTABLE_METACLASSES;
+ print STDERR "# of Metaclass options: ", keys %IMMUTABLE_OPTIONS;
+ print STDERR "# of Immutable transformers: ", keys %IMMUTABLE_TRANSFORMERS;
}
}
my $self = shift;
return if $self->is_mutable;
my $options = delete $IMMUTABLE_OPTIONS{refaddr $self};
- my $immutable_metaclass = delete $options->{IMMUTABLE_METACLASS};
- $immutable_metaclass->make_metaclass_mutable($self, %$options);
+ confess "unable to find immutabilizing options" unless $options;
+ my $transformer = delete $options->{IMMUTABLE_TRANSFORMER};
+ $transformer->make_metaclass_mutable($self, %$options);
}
+}
+sub create_immutable_transformer {
+ my $self = shift;
+ my $class = Class::MOP::Immutable->new($self, {
+ read_only => [qw/superclasses/],
+ cannot_call => [qw/
+ add_method
+ alias_method
+ remove_method
+ add_attribute
+ remove_attribute
+ add_package_symbol
+ remove_package_symbol
+ /],
+ memoize => {
+ class_precedence_list => 'ARRAY',
+ compute_all_applicable_attributes => 'ARRAY',
+ get_meta_instance => 'SCALAR',
+ get_method_map => 'SCALAR',
+ }
+ });
+ return $class;
}
1;
);
}
+
my %DEFAULT_METHODS = (
+ # I don't really understand this, but removing it breaks tests (groditi)
meta => sub {
my $self = shift;
# if it is not blessed, then someone is asking
# which has been made immutable, which is itself
return $self;
},
- is_mutable => sub { 0 },
- is_immutable => sub { 1 },
- make_immutable => sub { ( ) },
+ is_mutable => sub { 0 },
+ is_immutable => sub { 1 },
+ make_immutable => sub { () },
);
# NOTE:
use strict;
use warnings;
-use Test::More tests => 193;
+use Test::More tests => 195;
use Test::Exception;
BEGIN {
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_mutable make_immutable
+ is_mutable is_immutable make_mutable make_immutable create_immutable_transformer
DESTROY
);
use strict;
use warnings;
-use Test::More tests => 73;
+use Test::More tests => 83;
use Test::Exception;
BEGIN {
}
{
+ my $meta = Foo->meta;
+
+ my $transformer;
+ lives_ok{ $transformer = $meta->create_immutable_transformer }
+ "Created immutable transformer";
+ isa_ok($transformer, 'Class::MOP::Immutable', '... transformer isa Class::MOP::Immutable');
+ my $methods = $transformer->create_methods_for_immutable_metaclass;
+
+ my $immutable_metaclass = $transformer->immutable_metaclass;
+ is($transformer->metaclass, $meta, '... transformer has correct metaclass');
+ ok($immutable_metaclass->is_anon_class, '... immutable_metaclass is an anonymous class');
+
+ #I don't understand why i need to ->meta here...
+ my $obj = $immutable_metaclass->name;
+ ok(!$obj->is_mutable, '... immutable_metaclass is not mutable');
+ ok($obj->is_immutable, '... immutable_metaclass is immutable');
+ ok(!$obj->make_immutable, '... immutable_metaclass make_mutable is noop');
+ is($obj->meta, $immutable_metaclass, '... immutable_metaclass meta hack works');
+
+ is_deeply(
+ [ $immutable_metaclass->superclasses ],
+ [ $meta->blessed ],
+ '... immutable_metaclass superclasses are correct'
+ );
+ ok($immutable_metaclass->has_method('get_mutable_metaclass_name'));
+
+}
+
+{
my $meta = Foo->meta;
is($meta->name, 'Foo', '... checking the Foo metaclass');
use FindBin;
use File::Spec::Functions;
-use Test::More tests => 10;
+use Test::More tests => 15;
use Test::Exception;
use Scalar::Util;
{
my $meta = Baz->meta;
+ ok($meta->is_mutable, '... Baz is mutable');
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;
+ lives_ok { $meta->make_immutable } "Baz is now immutable";
+ ok($meta->is_immutable, '... Baz is 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');
+ lives_ok { $meta->make_mutable } "Baz is now mutable";
+ ok($meta->is_mutable, '... Baz is mutable again');
}
use strict;
use warnings;
-use Test::More tests => 101;
+use Test::More tests => 104;
use Test::Exception;
use Scalar::Util;
{
+ ok(Baz->meta->is_immutable, 'Superclass is immutable');
my $meta = Baz->meta->create_anon_class(superclasses => ['Baz']);
my @orig_keys = sort keys %$meta;
my @orig_meths = sort { $a->{name} cmp $b->{name} }
$meta->compute_all_applicable_methods;
ok($meta->is_anon_class, 'We have an anon metaclass');
+ ok($meta->is_mutable, '... our anon class is mutable');
+ ok(!$meta->is_immutable, '... our anon class is not immutable');
+
lives_ok {$meta->make_immutable(
inline_accessor => 1,
inline_destructor => 0,
projects / gitmo/Class-MOP.git / commitdiff