X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FMethod%2FConstructor.pm;h=31e02d79b47bf1b5183e401f934399838d84d6fa;hb=4da72c45030b36f43e7b9bfb15c38276f14db3a6;hp=8e0932ab00f0b97da120d0dcb55d1f20ad87eaff;hpb=f5bc97e5bbde4f29f52d85ac7c03251665dfd52b;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm index 8e0932a..31e02d7 100644 --- a/lib/Moose/Meta/Method/Constructor.pm +++ b/lib/Moose/Meta/Method/Constructor.pm @@ -6,7 +6,7 @@ use warnings; use Scalar::Util 'blessed', 'weaken', 'looks_like_number'; -our $VERSION = '0.60'; +our $VERSION = '0.68'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method', @@ -47,6 +47,64 @@ sub new { return $self; } +sub can_be_inlined { + my $self = shift; + my $metaclass = $self->associated_metaclass; + + my $expected_class = $self->_expected_constructor_class; + + # If any of our parents have been made immutable, we are okay to + # inline our own new method. The assumption is that an inlined new + # method provided by a parent does not actually get used by + # children anyway. + for my $meta ( + grep { $_->is_immutable } + map { ( ref $metaclass )->initialize($_) } + grep { $_ ne $expected_class } + $metaclass->linearized_isa + ) { + my $transformer = $meta->get_immutable_transformer; + + # This is actually a false positive if we're in a subclass of + # this class, _and_ the expected class is not overridden (but + # should be), and the real expected class is actually + # immutable itself (see Fey::Object::Table for an example of + # how this can happen). I'm not sure how to actually handle + # that case, since it's effectively a bug in the subclass (for + # not overriding _expected_constructor_class). + return 1 if $transformer->inlined_constructor; + } + + if ( my $constructor = $metaclass->find_method_by_name( $self->name ) ) { + my $class = $self->associated_metaclass->name; + + if ( $constructor->body != $expected_class->can('new') ) { + my $warning + = "Not inlining a constructor for $class since it is not" + . " inheriting the default $expected_class constructor\n"; + + $warning .= " (constructor has method modifiers which would be lost if it were inlined)\n" + if $constructor->isa('Class::MOP::Method::Wrapped'); + + warn $warning; + + return 0; + } + else { + return 1; + } + } + + # This would be a rather weird case where we have no constructor + # in the inheritance chain. + return 1; +} + +# This is here so can_be_inlined can be inherited by MooseX modules. +sub _expected_constructor_class { + return 'Moose::Object'; +} + ## accessors sub options { (shift)->{'options'} } @@ -84,42 +142,42 @@ sub initialize_body { $self->_generate_slot_initializer($_) } 0 .. (@{$self->attributes} - 1)); - $source .= ";\n" . $self->_generate_triggers(); + $source .= ";\n" . $self->_generate_triggers(); $source .= ";\n" . $self->_generate_BUILDALL(); $source .= ";\n" . 'return $instance'; $source .= ";\n" . '}'; warn $source if $self->options->{debug}; - my $code; - { - my $meta = $self; # FIXME for _inline_throw_error... - - # NOTE: - # create the nessecary lexicals - # to be picked up in the eval - my $attrs = $self->attributes; - - # We need to check if the attribute ->can('type_constraint') - # since we may be trying to immutabilize a Moose meta class, - # which in turn has attributes which are Class::MOP::Attribute - # objects, rather than Moose::Meta::Attribute. And - # Class::MOP::Attribute attributes have no type constraints. - # However we need to make sure we leave an undef value there - # because the inlined code is using the index of the attributes - # to determine where to find the type constraint - - my @type_constraints = map { - $_->can('type_constraint') ? $_->type_constraint : undef - } @$attrs; - - my @type_constraint_bodies = map { - defined $_ ? $_->_compiled_type_constraint : undef; - } @type_constraints; - - $code = eval $source; - $self->throw_error("Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@", error => $@, data => $source ) if $@; - } + # We need to check if the attribute ->can('type_constraint') + # since we may be trying to immutabilize a Moose meta class, + # which in turn has attributes which are Class::MOP::Attribute + # objects, rather than Moose::Meta::Attribute. And + # Class::MOP::Attribute attributes have no type constraints. + # However we need to make sure we leave an undef value there + # because the inlined code is using the index of the attributes + # to determine where to find the type constraint + + my $attrs = $self->attributes; + + my @type_constraints = map { + $_->can('type_constraint') ? $_->type_constraint : undef + } @$attrs; + + my @type_constraint_bodies = map { + defined $_ ? $_->_compiled_type_constraint : undef; + } @type_constraints; + + my $code = $self->_compile_code( + code => $source, + environment => { + '$meta' => \$self, + '$attrs' => \$attrs, + '@type_constraints' => \@type_constraints, + '@type_constraint_bodies' => \@type_constraint_bodies, + }, + ) or $self->throw_error("Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@", error => $@, data => $source ); + $self->{'body'} = $code; } @@ -334,13 +392,7 @@ sub _generate_default_value { return '$attrs->[' . $index . ']->default($instance)'; } else { - my $default = $attr->default; - # make sure to quote strings ... - unless (looks_like_number($default)) { - $default = "'$default'"; - } - - return $default; + return q{"} . quotemeta( $attr->default ) . q{"}; } } @@ -357,7 +409,7 @@ Moose::Meta::Method::Constructor - Method Meta Object for constructors =head1 DESCRIPTION This is a subclass of L which handles -constructing an approprate Constructor methods. This is primarily +constructing an appropriate Constructor methods. This is primarily used in the making of immutable metaclasses, otherwise it is not particularly useful. @@ -367,6 +419,8 @@ not particularly useful. =item B +=item B + =item B =item B @@ -385,7 +439,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2009 by Infinity Interactive, Inc. L