From: Fuji, Goro Date: Sat, 25 Sep 2010 09:35:55 +0000 (+0900) Subject: Remove the no-inline version of attribute initialization code X-Git-Tag: 0.72~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3a09e3898ca09a1dd734439a59d60b18575758c;p=gitmo%2FMouse.git Remove the no-inline version of attribute initialization code --- diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index 2ab14cb..decbfb1 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -238,6 +238,9 @@ sub add_attribute { Carp::carp(qq{Attribute ($name) of class }.$self->name .qq{ has no associated methods (did you mean to provide an "is" argument?)}); } + if(!Mouse::Util::MOUSE_XS) { + delete $self->{_initialize_object}; + } return $attr; } diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index ee75260..c45fd9c 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -11,43 +11,43 @@ sub _generate_constructor { my $associated_metaclass_name = $metaclass->name; - my @attrs = $metaclass->get_all_attributes; - my $buildall = $class->_generate_BUILDALL($metaclass); my $buildargs = $class->_generate_BUILDARGS($metaclass); - my $processattrs = $class->_generate_processattrs($metaclass, \@attrs); - - my @checks = map { $_ && $_->_compiled_type_constraint } - map { $_->type_constraint } @attrs; - my $source = sprintf("#line %d %s\n", __LINE__, __FILE__).<<"..."; - sub \{ - my \$class = shift; - return \$class->Mouse::Object::new(\@_) - if \$class ne q{$associated_metaclass_name}; + my $source = sprintf(<<'EOT', __LINE__, __FILE__, $metaclass->name, $buildargs, $buildall); +#line %d %s + package %s; + sub { + my $class = shift; + return $class->Mouse::Object::new(@_) + if $class ne __PACKAGE__; # BUILDARGS - $buildargs; - my \$instance = bless {}, \$class; - # process attributes - $processattrs; + %s; + my $instance = bless {}, $class; + $metaclass->_initialize_object($instance, $args, 0); # BUILDALL - $buildall; - return \$instance; + %s; + return $instance; } -... +EOT #warn $source; - my $code; + my $body; my $e = do{ local $@; - $code = eval $source; + $body = eval $source; $@; }; die $e if $e; - return $code; + return $body; } -sub _generate_processattrs { - my ($method_class, $metaclass, $attrs) = @_; +sub _generate_initialize_object { + my ($method_class, $metaclass) = @_; + my @attrs = $metaclass->get_all_attributes; + + my @checks = map { $_ && $_->_compiled_type_constraint } + map { $_->type_constraint } @attrs; + my @res; my $has_triggers; @@ -57,10 +57,10 @@ sub _generate_processattrs { push @res, 'my $used = 0;'; } - for my $index (0 .. @$attrs - 1) { + for my $index (0 .. @attrs - 1) { my $code = ''; - my $attr = $attrs->[$index]; + my $attr = $attrs[$index]; my $key = $attr->name; my $init_arg = $attr->init_arg; @@ -81,13 +81,15 @@ sub _generate_processattrs { my $post_process = ''; if(defined $type_constraint){ - $post_process .= "\$checks[$index]->($instance_slot)"; + $post_process .= "\$checks[$index]->($instance_slot)\n"; $post_process .= " or $attr_var->_throw_type_constraint_error($instance_slot, $constraint_var);\n"; } if($is_weak_ref){ - $post_process .= "Scalar::Util::weaken($instance_slot) if ref $instance_slot;\n"; + $post_process = "Scalar::Util::weaken($instance_slot) " + . "if ref $instance_slot;\n"; } + # build cde for an attribute if (defined $init_arg) { my $value = "\$args->{q{$init_arg}}"; @@ -136,13 +138,12 @@ sub _generate_processattrs { } $code .= "$instance_slot = $value;\n"; - if($is_weak_ref){ - $code .= "Scalar::Util::weaken($instance_slot);\n"; - } + $code .= $post_process; } } elsif ($attr->is_required) { - $code .= "Carp::confess('Attribute ($key) is required');"; + $code .= "\$meta->throw_error('Attribute ($key) is required')"; + $code .= " unless \$is_cloning;\n"; } $code .= "}\n" if defined $init_arg; @@ -152,11 +153,11 @@ sub _generate_processattrs { if($strict){ push @res, q{if($used < keys %{$args})} - . q{{ $metaclass->_report_unknown_args(\@attrs, $args) }}; + . q{{ $meta->_report_unknown_args(\@attrs, $args) }}; } if($metaclass->is_anon_class){ - push @res, q{$instance->{__METACLASS__} = $metaclass;}; + push @res, q{$instance->{__METACLASS__} = $meta;}; } if($has_triggers){ @@ -164,7 +165,24 @@ sub _generate_processattrs { push @res, q{$_->[0]->($instance, $_->[1]) for @triggers;}; } - return join "\n", @res; + my $source = sprintf <<'EOT', __LINE__, __FILE__, $metaclass->name, join "\n", @res; +#line %d %s + package %s; + sub { + my($meta, $instance, $args, $is_cloning) = @_; + %s; + return $instance; + } +EOT + warn $source if $ENV{MOUSE_DEBUG}; + my $body; + my $e = do { + local $@; + $body = eval $source; + $@; + }; + die $e if $e; + return $body; } sub _generate_BUILDARGS { diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index fb1909f..fefcbcc 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -294,7 +294,7 @@ sub new_object { my $object = bless {}, $meta->name; - $meta->_initialize_object($object, \%args); + $meta->_initialize_object($object, \%args, 0); # BUILDALL if( $object->can('BUILD') ) { for my $class (reverse $meta->linearized_isa) { @@ -323,63 +323,11 @@ sub clone_object { sub _initialize_object{ my($self, $object, $args, $is_cloning) = @_; - - my @triggers_queue; - - my $used = 0; - - foreach my $attribute ($self->get_all_attributes) { - my $init_arg = $attribute->init_arg; - my $slot = $attribute->name; - - if (defined($init_arg) && exists($args->{$init_arg})) { - $object->{$slot} = $attribute->_coerce_and_verify($args->{$init_arg}, $object); - - weaken($object->{$slot}) - if ref($object->{$slot}) && $attribute->is_weak_ref; - - if ($attribute->has_trigger) { - push @triggers_queue, [ $attribute->trigger, $object->{$slot} ]; - } - $used++; - } - else { # no init arg - if ($attribute->has_default || $attribute->has_builder) { - if (!$attribute->is_lazy && !exists $object->{$slot}) { - my $default = $attribute->default; - my $builder = $attribute->builder; - my $value = $builder ? $object->$builder() - : ref($default) eq 'CODE' ? $object->$default() - : $default; - - $object->{$slot} = $attribute->_coerce_and_verify($value, $object); - - weaken($object->{$slot}) - if ref($object->{$slot}) && $attribute->is_weak_ref; - } - } - elsif(!$is_cloning && $attribute->is_required) { - $self->throw_error("Attribute (".$attribute->name.") is required"); - } - } - } - - if($used < keys %{$args} && $self->strict_constructor) { - $self->_report_unknown_args([ $self->get_all_attributes ], $args); - } - - if(@triggers_queue){ - foreach my $trigger_and_value(@triggers_queue){ - my($trigger, $value) = @{$trigger_and_value}; - $trigger->($object, $value); - } - } - - if($self->is_anon_class){ - $object->{__METACLASS__} = $self; - } - - return; + my $initializer = $self->{_initialize_object} ||= do { + Mouse::Util::load_class($self->constructor_class) + ->_generate_initialize_object($self); + }; + goto &{$initializer}; } sub is_immutable { $_[0]->{is_immutable} } @@ -738,9 +686,8 @@ sub DESTROY { return unless $self->can('DEMOLISH'); # short circuit - local $?; - my $e = do{ + local $?; local $@; eval{ # DEMOLISHALL