From: Stevan Little Date: Thu, 2 Nov 2006 14:33:56 +0000 (+0000) Subject: immutable refacotring X-Git-Tag: 0_37~9^3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d90b42a6df39896a4a851b6174cce7558173d7d5;hp=fdbdb5e6eb0e4f6c54629f0bde376aba5e69df14;p=gitmo%2FClass-MOP.git immutable refacotring --- diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index 66db0e2..adbccfa 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -373,6 +373,56 @@ Class::MOP::Method::Wrapped->meta->add_attribute( ); ## -------------------------------------------------------- +## Class::MOP::Method::Accessor + +Class::MOP::Method::Accessor->meta->add_attribute( + Class::MOP::Attribute->new('attribute' => ( + reader => { + 'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute + }, + )) +); + +Class::MOP::Method::Accessor->meta->add_attribute( + Class::MOP::Attribute->new('accessor_type' => ( + reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type }, + )) +); + +Class::MOP::Method::Accessor->meta->add_attribute( + Class::MOP::Attribute->new('is_inline' => ( + reader => { 'is_inline' => \&Class::MOP::Method::Accessor::is_inline }, + )) +); + +## -------------------------------------------------------- +## Class::MOP::Method::Constructor + +Class::MOP::Method::Constructor->meta->add_attribute( + Class::MOP::Attribute->new('options' => ( + reader => { + 'options' => \&Class::MOP::Method::Constructor::options + }, + )) +); + +Class::MOP::Method::Constructor->meta->add_attribute( + Class::MOP::Attribute->new('meta_instance' => ( + reader => { + 'meta_instance' => \&Class::MOP::Method::Constructor::meta_instance + }, + )) +); + +Class::MOP::Method::Constructor->meta->add_attribute( + Class::MOP::Attribute->new('attributes' => ( + reader => { + 'attributes' => \&Class::MOP::Method::Constructor::attributes + }, + )) +); + +## -------------------------------------------------------- ## Class::MOP::Instance # NOTE: @@ -412,7 +462,8 @@ $_->meta->make_immutable( Class::MOP::Object Class::MOP::Method::Accessor - Class::MOP::Method::Wrapped + Class::MOP::Method::Constructor + Class::MOP::Method::Wrapped /; 1; diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index c8ab6c0..376b9b1 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -211,7 +211,7 @@ sub process_accessors { eval { $method = $self->accessor_metaclass->new( attribute => $self, - as_inline => $inline_me, + is_inline => $inline_me, accessor_type => $type, ); }; diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index afd2789..96d1402 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -70,7 +70,6 @@ sub construct_class_instance { : blessed($class)) : $class); - $class = blessed($class) || $class; # now create the metaclass my $meta; if ($class =~ /^Class::MOP::Class$/) { diff --git a/lib/Class/MOP/Class/Immutable.pm b/lib/Class/MOP/Class/Immutable.pm index 942708c..0f58927 100644 --- a/lib/Class/MOP/Class/Immutable.pm +++ b/lib/Class/MOP/Class/Immutable.pm @@ -4,8 +4,10 @@ package Class::MOP::Class::Immutable; use strict; use warnings; +use Class::MOP::Method::Constructor; + use Carp 'confess'; -use Scalar::Util 'blessed', 'looks_like_number'; +use Scalar::Util 'blessed'; our $VERSION = '0.03'; our $AUTHORITY = 'cpan:STEVAN'; @@ -41,19 +43,6 @@ for my $meth (qw( }; } -sub get_package_symbol { - my ($self, $variable) = @_; - my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); - return *{$self->namespace->{$name}}{$type} - if exists $self->namespace->{$name}; - # NOTE: - # we have to do this here in order to preserve - # perl's autovivification of variables. However - # we do cut off direct access to add_package_symbol - # as shown above. - $self->Class::MOP::Package::add_package_symbol($variable); -} - # NOTE: # superclasses is an accessor, so # it just cannot be changed @@ -88,87 +77,37 @@ sub make_metaclass_immutable { if ($options{inline_accessors}) { foreach my $attr_name ($metaclass->get_attribute_list) { - my $attr = $metaclass->get_attribute($attr_name); - $attr->install_accessors(1); # inline the accessors + # inline the accessors + $metaclass->get_attribute($attr_name) + ->install_accessors(1); } } if ($options{inline_constructor}) { + my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor'; $metaclass->add_method( $options{constructor_name}, - $class->_generate_inline_constructor( - \%options, - $meta_instance, - $metaclass->{'___compute_all_applicable_attributes'} - ) + $constructor_class->new( + options => \%options, + meta_instance => $meta_instance, + attributes => $metaclass->{'___compute_all_applicable_attributes'} + ) ); } # now cache the method map ... - $metaclass->{'___method_map'} = $metaclass->get_method_map; + $metaclass->{'___get_method_map'} = $metaclass->get_method_map; bless $metaclass => $class; } -sub _generate_inline_constructor { - my ($class, $options, $meta_instance, $attrs) = @_; - # TODO: - # the %options should also include a both - # a call 'initializer' and call 'SUPER::' - # options, which should cover approx 90% - # of the possible use cases (even if it - # requires some adaption on the part of - # the author, after all, nothing is free) - my $source = 'sub {'; - $source .= "\n" . 'my ($class, %params) = @_;'; - $source .= "\n" . 'my $instance = ' . $meta_instance->inline_create_instance('$class'); - $source .= ";\n" . (join ";\n" => map { - $class->_generate_slot_initializer($meta_instance, $attrs, $_) - } 0 .. (@$attrs - 1)); - $source .= ";\n" . 'return $instance'; - $source .= ";\n" . '}'; - warn $source if $options->{debug}; - my $code = eval $source; - confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@; - return $code; -} - -sub _generate_slot_initializer { - my ($class, $meta_instance, $attrs, $index) = @_; - my $attr = $attrs->[$index]; - my $default; - if ($attr->has_default) { - # NOTE: - # default values can either be CODE refs - # in which case we need to call them. Or - # they can be scalars (strings/numbers) - # in which case we can just deal with them - # in the code we eval. - if ($attr->is_default_a_coderef) { - $default = '$attrs->[' . $index . ']->default($instance)'; - } - else { - $default = $attrs->[$index]->default; - # make sure to quote strings ... - unless (looks_like_number($default)) { - $default = "'$default'"; - } - } - } - $meta_instance->inline_set_slot_value( - '$instance', - ("'" . $attr->name . "'"), - ('$params{\'' . $attr->init_arg . '\'}' . (defined $default ? (' || ' . $default) : '')) - ) -} - # cached methods 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'} } -sub get_method_map { (shift)->{'___method_map'} } +sub get_method_map { (shift)->{'___get_method_map'} } 1; @@ -289,11 +228,6 @@ to this method, which This method becomes read-only in an immutable class. -=item B - -This method must handle package variable autovivification -correctly, while still disallowing C. - =back =head2 Cached methods diff --git a/lib/Class/MOP/Immutable.pm b/lib/Class/MOP/Immutable.pm new file mode 100644 index 0000000..4e4c33e --- /dev/null +++ b/lib/Class/MOP/Immutable.pm @@ -0,0 +1,133 @@ + +package Class::MOP::Immutable; + +1; + +__END__ + +=pod + +Okay, so here is the basic idea. + +First, your metaclass must register with Class::MOP::Immutable +at which point an anon-class is created which will be the +immutable class which your metaclass will be blessed into. + +This allows immutable versions of any metaclass to be created +on the fly if needed. + +NOTE: +Remember the immutable version of the metaclass will be used to +construct/convert mutable instances into immutable versions. So +it itself is a metaclass. + + Class::MOP::Immutable->make_immutable_metaclass( + # name of the metaclass we are + # making immutable + metaclass => 'Class::MOP::Class', + + # names of some method metaclasses + # which will be useful in the creation + # of the immutable versions + constructor_class => 'Class::MOP::Method::Constructor', + accessor_class => 'Class::MOP::Method::Accessor', # ?? maybe + + # options which the immutable converter + # will accept, not exactly sure about + # this one,.. it might have to be hard + # coded in some way. + available_options => [qw[ + inline_accessors + inline_constructor + constructor_name + ]], + + # multiple lists of things which can + # be done to the metaclass .. + + # make these methods die when called + disallow => [qw[ + add_method + alias_method + remove_method + add_attribute + remove_attribute + add_package_symbol + remove_package_symbol + ]], + + # memoize the value of these methods + memoize => [qw[ + class_precedence_list + compute_all_applicable_attributes + get_meta_instance + get_method_map + ]], + + # make these methods read only + readonly => [qw[ + superclasses + ]], + ); + +Now, this will work just fine for singular metas, but +we want this to be able to work for extensions to the +metaclasses as well. + +Here is how we do that: + + Class::MOP::Immutable->make_immutable_metaclass( + # the metaclass name ... + metaclass => 'Moose::Meta::Class', + + # inherit the options from immutable + # parent class (Class::MOP::Class) + inherit => 1 + + constructor_class => 'Moose::Method::Constructor', + accessor_class => 'Moose::Method::Accessor', # ?? maybe + + disallow => [qw[ + add_roles + ... + ]], + + memoize => [qw[ + roles + ... + ]] + ); + +When you specify C 1> you are telling +Class::MOP::Immutable that you want to inherit your +parents options. This means that you get all their +and yours (perhaps some basic conflict resolution +can be added here as well). + +It might make sense to also allow a more granular +approach such as: + + inherit => { + disallow => 'merge', + memoize => 'override', + readonly => 'ignore', + } + +which would allow you to specify in more detail how +you would like to handle each change. This might be +more than anyone ever needs so we can probably hold +off for now. + +Ultimately it will be the responsibility of the +author to make sure their immutable options make sense. + +The reason I say this is that you could easily get +carried away in the number of items you choose to +memoize or such. This would not make a lot of sense, +it would make more sense to memoize at the "topmost" +level instead, rather than all the intermediate ones. + +It's basically gonna be a trade off. + +=cut + diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm index 1c0ea40..237dd0e 100644 --- a/lib/Class/MOP/Method/Accessor.pm +++ b/lib/Class/MOP/Method/Accessor.pm @@ -30,7 +30,7 @@ sub new { body => undef, # specific to this subclass attribute => $options{attribute}, - as_inline => ($options{as_inline} || 0), + is_inline => ($options{is_inline} || 0), accessor_type => $options{accessor_type}, } => $class; @@ -48,7 +48,7 @@ sub new { sub associated_attribute { (shift)->{attribute} } sub accessor_type { (shift)->{accessor_type} } -sub as_inline { (shift)->{as_inline} } +sub is_inline { (shift)->{is_inline} } ## factory @@ -59,7 +59,7 @@ sub intialize_body { 'generate', $self->accessor_type, 'method', - ($self->as_inline ? 'inline' : ()) + ($self->is_inline ? 'inline' : ()) ); eval { $self->{body} = $self->$method_name() }; @@ -202,7 +202,7 @@ Class::MOP::Method::Accessor - Method Meta Object for accessors =item B -=item B +=item B =item B @@ -232,8 +232,6 @@ Class::MOP::Method::Accessor - Method Meta Object for accessors Stevan Little Estevan@iinteractive.comE -Yuval Kogman Enothingmuch@woobling.comE - =head1 COPYRIGHT AND LICENSE Copyright 2006 by Infinity Interactive, Inc. diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm new file mode 100644 index 0000000..08812bc --- /dev/null +++ b/lib/Class/MOP/Method/Constructor.pm @@ -0,0 +1,169 @@ + +package Class::MOP::Method::Constructor; + +use strict; +use warnings; + +use Carp 'confess'; +use Scalar::Util 'blessed', 'weaken', 'looks_like_number'; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +use base 'Class::MOP::Method'; + +sub new { + my $class = shift; + my %options = @_; + + (exists $options{options} && ref $options{options} eq 'HASH') + || confess "You must pass a hash of options"; + + (blessed $options{meta_instance} && $options{meta_instance}->isa('Class::MOP::Instance')) + || confess "You must supply a meta-instance"; + + (exists $options{attributes} && ref $options{attributes} eq 'ARRAY') + || confess "You must pass an array of options"; + + (blessed($_) && $_->isa('Class::MOP::Attribute')) + || confess "You must supply a list of attributes which is a 'Class::MOP::Attribute' instance" + for @{$options{attributes}}; + + my $self = bless { + # from our superclass + body => undef, + # specific to this subclass + options => $options{options}, + meta_instance => $options{meta_instance}, + attributes => $options{attributes}, + } => $class; + + # we don't want this creating + # a cycle in the code, if not + # needed + weaken($self->{meta_instance}); + + $self->intialize_body; + + return $self; +} + +## accessors + +sub options { (shift)->{options} } +sub meta_instance { (shift)->{meta_instance} } +sub attributes { (shift)->{attributes} } + +## method + +sub intialize_body { + my $self = shift; + # TODO: + # the %options should also include a both + # a call 'initializer' and call 'SUPER::' + # options, which should cover approx 90% + # of the possible use cases (even if it + # requires some adaption on the part of + # the author, after all, nothing is free) + my $source = 'sub {'; + $source .= "\n" . 'my ($class, %params) = @_;'; + $source .= "\n" . 'my $instance = ' . $self->meta_instance->inline_create_instance('$class'); + $source .= ";\n" . (join ";\n" => map { + $self->_generate_slot_initializer($_) + } 0 .. (@{$self->attributes} - 1)); + $source .= ";\n" . 'return $instance'; + $source .= ";\n" . '}'; + warn $source if $self->options->{debug}; + + my $code; + { + # NOTE: + # create the nessecary lexicals + # to be picked up in the eval + my $attrs = $self->attributes; + + $code = eval $source; + confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@; + } + $self->{body} = $code; +} + +sub _generate_slot_initializer { + my $self = shift; + my $index = shift; + + my $attr = $self->attributes->[$index]; + + my $default; + if ($attr->has_default) { + # NOTE: + # default values can either be CODE refs + # in which case we need to call them. Or + # they can be scalars (strings/numbers) + # in which case we can just deal with them + # in the code we eval. + if ($attr->is_default_a_coderef) { + $default = '$attrs->[' . $index . ']->default($instance)'; + } + else { + $default = $attr->default; + # make sure to quote strings ... + unless (looks_like_number($default)) { + $default = "'$default'"; + } + } + } + $self->meta_instance->inline_set_slot_value( + '$instance', + ("'" . $attr->name . "'"), + ('$params{\'' . $attr->init_arg . '\'}' . (defined $default ? (' || ' . $default) : '')) + ); +} + +1; + +1; + +__END__ + +=pod + +=head1 NAME + +Class::MOP::Method::Constructor - Method Meta Object for constructors + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +=head1 AUTHORS + +Stevan Little Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + diff --git a/t/000_load.t b/t/000_load.t index cb43aef..c7ba2c5 100644 --- a/t/000_load.t +++ b/t/000_load.t @@ -3,13 +3,19 @@ use strict; use warnings; -use Test::More tests => 22; +use Test::More tests => 29; BEGIN { use_ok('Class::MOP'); + use_ok('Class::MOP::Package'); + use_ok('Class::MOP::Module'); use_ok('Class::MOP::Class'); + use_ok('Class::MOP::Class::Immutable'); use_ok('Class::MOP::Attribute'); - use_ok('Class::MOP::Method'); + use_ok('Class::MOP::Method'); + use_ok('Class::MOP::Method::Wrapped'); + use_ok('Class::MOP::Method::Accessor'); + use_ok('Class::MOP::Method::Constructor'); use_ok('Class::MOP::Instance'); use_ok('Class::MOP::Object'); } @@ -18,10 +24,11 @@ BEGIN { my %METAS = ( 'Class::MOP::Attribute' => Class::MOP::Attribute->meta, - 'Class::MOP::Method::Accessor' => Class::MOP::Method::Accessor->meta, + 'Class::MOP::Method::Accessor' => Class::MOP::Method::Accessor->meta, + 'Class::MOP::Method::Constructor' => Class::MOP::Method::Constructor->meta, 'Class::MOP::Package' => Class::MOP::Package->meta, 'Class::MOP::Module' => Class::MOP::Module->meta, - 'Class::MOP::Class' => Class::MOP::Class->meta, + 'Class::MOP::Class' => Class::MOP::Class->meta, 'Class::MOP::Method' => Class::MOP::Method->meta, 'Class::MOP::Method::Wrapped' => Class::MOP::Method::Wrapped->meta, 'Class::MOP::Instance' => Class::MOP::Instance->meta, @@ -42,7 +49,8 @@ is_deeply( Class::MOP::Class->meta, Class::MOP::Instance->meta, Class::MOP::Method->meta, - Class::MOP::Method::Accessor->meta, + Class::MOP::Method::Accessor->meta, + Class::MOP::Method::Constructor->meta, Class::MOP::Method::Wrapped->meta, Class::MOP::Module->meta, Class::MOP::Object->meta, @@ -57,7 +65,8 @@ is_deeply( Class::MOP::Class Class::MOP::Instance Class::MOP::Method - Class::MOP::Method::Accessor + Class::MOP::Method::Accessor + Class::MOP::Method::Constructor Class::MOP::Method::Wrapped Class::MOP::Module Class::MOP::Object @@ -73,6 +82,7 @@ is_deeply( "Class::MOP::Instance-" . $Class::MOP::Instance::VERSION . "-cpan:STEVAN", "Class::MOP::Method-" . $Class::MOP::Method::VERSION . "-cpan:STEVAN", "Class::MOP::Method::Accessor-" . $Class::MOP::Method::Accessor::VERSION . "-cpan:STEVAN", + "Class::MOP::Method::Constructor-" . $Class::MOP::Method::Constructor::VERSION . "-cpan:STEVAN", "Class::MOP::Method::Wrapped-" . $Class::MOP::Method::Wrapped::VERSION . "-cpan:STEVAN", "Class::MOP::Module-" . $Class::MOP::Module::VERSION . "-cpan:STEVAN", "Class::MOP::Object-" . $Class::MOP::Object::VERSION . "-cpan:STEVAN", diff --git a/t/072_immutable_w_constructors.t b/t/072_immutable_w_constructors.t new file mode 100644 index 0000000..aeeaff6 --- /dev/null +++ b/t/072_immutable_w_constructors.t @@ -0,0 +1,242 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 76; +use Test::Exception; + +BEGIN { + use_ok('Class::MOP'); + use_ok('Class::MOP::Class::Immutable'); +} + +{ + package Foo; + + use strict; + use warnings; + use metaclass; + + __PACKAGE__->meta->add_attribute('bar' => ( + reader => 'bar', + default => 'BAR', + )); + + package Bar; + + use strict; + use warnings; + use metaclass; + + __PACKAGE__->meta->superclasses('Foo'); + + __PACKAGE__->meta->add_attribute('baz' => ( + reader => 'baz', + default => sub { 'BAZ' }, + )); + + package Baz; + + use strict; + use warnings; + use metaclass; + + __PACKAGE__->meta->superclasses('Bar'); + + __PACKAGE__->meta->add_attribute('bah' => ( + reader => 'bah', + default => 'BAH', + )); +} + +{ + my $meta = Foo->meta; + is($meta->name, 'Foo', '... checking the Foo metaclass'); + + { + my $bar_accessor = $meta->get_method('bar'); + isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($bar_accessor, 'Class::MOP::Method'); + + ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined'); + } + + ok(!$meta->is_immutable, '... our class is not immutable'); + + lives_ok { + $meta->make_immutable( + inline_constructor => 1, + inline_accessors => 0, + ); + } '... changed Foo to be immutable'; + + ok($meta->is_immutable, '... our class is now immutable'); + isa_ok($meta, 'Class::MOP::Class::Immutable'); + isa_ok($meta, 'Class::MOP::Class'); + + # they made a constructor for us :) + can_ok('Foo', 'new'); + + { + my $foo = Foo->new; + isa_ok($foo, 'Foo'); + is($foo->bar, 'BAR', '... got the right default value'); + } + + { + my $foo = Foo->new(bar => 'BAZ'); + isa_ok($foo, 'Foo'); + is($foo->bar, 'BAZ', '... got the right parameter value'); + } + + # check out accessors too + { + my $bar_accessor = $meta->get_method('bar'); + isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($bar_accessor, 'Class::MOP::Method'); + + ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined'); + } +} + +{ + my $meta = Bar->meta; + is($meta->name, 'Bar', '... checking the Bar metaclass'); + + { + my $bar_accessor = $meta->find_method_by_name('bar'); + isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($bar_accessor, 'Class::MOP::Method'); + + ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined'); + + my $baz_accessor = $meta->get_method('baz'); + isa_ok($baz_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($baz_accessor, 'Class::MOP::Method'); + + ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined'); + } + + ok(!$meta->is_immutable, '... our class is not immutable'); + + lives_ok { + $meta->make_immutable( + inline_constructor => 1, + inline_accessors => 1, + ); + } '... changed Bar to be immutable'; + + ok($meta->is_immutable, '... our class is now immutable'); + isa_ok($meta, 'Class::MOP::Class::Immutable'); + isa_ok($meta, 'Class::MOP::Class'); + + # they made a constructor for us :) + can_ok('Bar', 'new'); + + { + my $bar = Bar->new; + isa_ok($bar, 'Bar'); + is($bar->bar, 'BAR', '... got the right default value'); + is($bar->baz, 'BAZ', '... got the right default value'); + } + + { + my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!'); + isa_ok($bar, 'Bar'); + is($bar->bar, 'BAZ!', '... got the right parameter value'); + is($bar->baz, 'BAR!', '... got the right parameter value'); + } + + # check out accessors too + { + my $bar_accessor = $meta->find_method_by_name('bar'); + isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($bar_accessor, 'Class::MOP::Method'); + + ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined'); + + my $baz_accessor = $meta->get_method('baz'); + isa_ok($baz_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($baz_accessor, 'Class::MOP::Method'); + + ok($baz_accessor->is_inline, '... the baz accessor is not inlined'); + } +} + +{ + my $meta = Baz->meta; + is($meta->name, 'Baz', '... checking the Bar metaclass'); + + { + my $bar_accessor = $meta->find_method_by_name('bar'); + isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($bar_accessor, 'Class::MOP::Method'); + + ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined'); + + my $baz_accessor = $meta->find_method_by_name('baz'); + isa_ok($baz_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($baz_accessor, 'Class::MOP::Method'); + + ok($baz_accessor->is_inline, '... the baz accessor is inlined'); + + my $bah_accessor = $meta->get_method('bah'); + isa_ok($bah_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($bah_accessor, 'Class::MOP::Method'); + + ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined'); + } + + ok(!$meta->is_immutable, '... our class is not immutable'); + + lives_ok { + $meta->make_immutable( + inline_constructor => 0, + inline_accessors => 1, + ); + } '... changed Bar to be immutable'; + + ok($meta->is_immutable, '... our class is now immutable'); + isa_ok($meta, 'Class::MOP::Class::Immutable'); + isa_ok($meta, 'Class::MOP::Class'); + + ok(!Baz->meta->has_method('new'), '... no constructor was made'); + + { + my $baz = Baz->meta->construct_instance; + isa_ok($baz, 'Bar'); + is($baz->bar, 'BAR', '... got the right default value'); + is($baz->baz, 'BAZ', '... got the right default value'); + } + + { + my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!'); + isa_ok($baz, 'Baz'); + is($baz->bar, 'BAZ!', '... got the right parameter value'); + is($baz->baz, 'BAR!', '... got the right parameter value'); + is($baz->bah, 'BAH!', '... got the right parameter value'); + } + + # check out accessors too + { + my $bar_accessor = $meta->find_method_by_name('bar'); + isa_ok($bar_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($bar_accessor, 'Class::MOP::Method'); + + ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined'); + + my $baz_accessor = $meta->find_method_by_name('baz'); + isa_ok($baz_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($baz_accessor, 'Class::MOP::Method'); + + ok($baz_accessor->is_inline, '... the baz accessor is not inlined'); + + my $bah_accessor = $meta->get_method('bah'); + isa_ok($bah_accessor, 'Class::MOP::Method::Accessor'); + isa_ok($bah_accessor, 'Class::MOP::Method'); + + ok($bah_accessor->is_inline, '... the baz accessor is not inlined'); + } +} +