From: Matt S Trout Date: Sun, 16 Dec 2007 22:36:54 +0000 (+0000) Subject: fix make_mutable when option values defaulted X-Git-Tag: 0_51~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=229910b5cf0bee35e072db0f8305e799241d4366;p=gitmo%2FClass-MOP.git fix make_mutable when option values defaulted --- diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 0f39343..652a827 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -808,7 +808,7 @@ sub is_immutable { 0 } $IMMUTABLE_TRANSFORMERS{$class} ||= $self->create_immutable_transformer; my $transformer = $IMMUTABLE_TRANSFORMERS{$class}; - $transformer->make_metaclass_immutable($self, %options); + $transformer->make_metaclass_immutable($self, \%options); $IMMUTABLE_OPTIONS{$self->name} = { %options, IMMUTABLE_TRANSFORMER => $transformer }; @@ -824,7 +824,7 @@ sub is_immutable { 0 } my $options = delete $IMMUTABLE_OPTIONS{$self->name}; confess "unable to find immutabilizing options" unless ref $options; my $transformer = delete $options->{IMMUTABLE_TRANSFORMER}; - $transformer->make_metaclass_mutable($self, %$options); + $transformer->make_metaclass_mutable($self, $options); } } diff --git a/lib/Class/MOP/Immutable.pm b/lib/Class/MOP/Immutable.pm index 5898faa..0b408e1 100644 --- a/lib/Class/MOP/Immutable.pm +++ b/lib/Class/MOP/Immutable.pm @@ -69,13 +69,19 @@ my %DEFAULT_METHODS = ( # existing metaclass to an immutable # version of itself sub make_metaclass_immutable { - my ($self, $metaclass, %options) = @_; + my ($self, $metaclass, $options) = @_; + + foreach my $pair ( + [ inline_accessors => 1 ], + [ inline_constructor => 1 ], + [ inline_destructor => 0 ], + [ constructor_name => 'new' ], + [ debug => 0 ], + ) { + $options->{$pair->[0]} = $pair->[1] unless exists $options->{$pair->[0]}; + } - $options{inline_accessors} = 1 unless exists $options{inline_accessors}; - $options{inline_constructor} = 1 unless exists $options{inline_constructor}; - $options{inline_destructor} = 0 unless exists $options{inline_destructor}; - $options{constructor_name} = 'new' unless exists $options{constructor_name}; - $options{debug} = 0 unless exists $options{debug}; + my %options = %$options; if ($options{inline_accessors}) { foreach my $attr_name ($metaclass->get_attribute_list) { @@ -141,7 +147,9 @@ sub make_metaclass_immutable { } sub make_metaclass_mutable { - my ($self, $immutable, %options) = @_; + my ($self, $immutable, $options) = @_; + + my %options = %$options; my $original_class = $immutable->get_mutable_metaclass_name; delete $immutable->{'___original_class'} ; @@ -180,7 +188,6 @@ sub make_metaclass_mutable { # 14:26 <@stevan> the only user of ::Method::Constructor is immutable # 14:27 <@stevan> if someone uses it outside of immutable,.. they are either: mst or groditi # 14:27 <@stevan> so I am not worried - $options{constructor_name} = 'new' unless exists $options{constructor_name}; if ($options{inline_constructor}) { my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor'; $immutable->remove_method( $options{constructor_name} ) diff --git a/t/073_make_mutable.t b/t/073_make_mutable.t index e753208..66b432a 100644 --- a/t/073_make_mutable.t +++ b/t/073_make_mutable.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 104; +use Test::More tests => 108; use Test::Exception; use Scalar::Util; @@ -51,11 +51,13 @@ BEGIN { 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'); + ok($meta->get_method_map->{new}, '... inlined constructor created'); 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'); + ok(!$meta->get_method_map->{new}, '... inlined constructor removed'); my @new_keys = sort keys %$meta; is_deeply(\@orig_keys, \@new_keys, '... no straneous hashkeys'); @@ -88,6 +90,9 @@ BEGIN { ok( $meta->$_ , "... ${_} works") for qw(get_meta_instance compute_all_applicable_attributes class_precedence_list get_method_map ); + + lives_ok {$meta->make_immutable; } '... changed Baz to be immutable again'; + ok($meta->get_method_map->{new}, '... inlined constructor recreated'); } {