From: Matt S Trout Date: Fri, 12 Dec 2008 08:16:01 +0000 (+0000) Subject: switch to hashref-based _eval_closure X-Git-Tag: 0.76~10^2~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0c6f32800dad3cfe10510f2443d2cac4c9a1a76f;p=gitmo%2FClass-MOP.git switch to hashref-based _eval_closure --- diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm index 3af250f..8e52f22 100644 --- a/lib/Class/MOP/Method/Accessor.pm +++ b/lib/Class/MOP/Method/Accessor.pm @@ -120,7 +120,7 @@ sub generate_accessor_method_inline { my $meta_instance = $attr->associated_class->instance_metaclass; my $code = $self->_eval_closure( - q{}, + {}, 'sub {' . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') . ' if scalar(@_) == 2; ' @@ -139,7 +139,7 @@ sub generate_reader_method_inline { my $meta_instance = $attr->associated_class->instance_metaclass; my $code = $self->_eval_closure( - q{}, + {}, 'sub {' . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;' . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'") @@ -157,7 +157,7 @@ sub generate_writer_method_inline { my $meta_instance = $attr->associated_class->instance_metaclass; my $code = $self->_eval_closure( - q{}, + {}, 'sub {' . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') . '}' @@ -175,7 +175,7 @@ sub generate_predicate_method_inline { my $meta_instance = $attr->associated_class->instance_metaclass; my $code = $self->_eval_closure( - q{}, + {}, 'sub {' . $meta_instance->inline_is_slot_initialized('$_[0]', "'$attr_name'") . '}' @@ -192,7 +192,7 @@ sub generate_clearer_method_inline { my $meta_instance = $attr->associated_class->instance_metaclass; my $code = $self->_eval_closure( - q{}, + {}, 'sub {' . $meta_instance->inline_deinitialize_slot('$_[0]', "'$attr_name'") . '}' diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm index 7179940..aeaa607 100644 --- a/lib/Class/MOP/Method/Constructor.pm +++ b/lib/Class/MOP/Method/Constructor.pm @@ -89,6 +89,8 @@ sub generate_constructor_method { sub generate_constructor_method_inline { my $self = shift; + my $close_over = {}; + my $source = 'sub {'; $source .= "\n" . 'my $class = shift;'; @@ -112,7 +114,7 @@ sub generate_constructor_method_inline { # to be picked up in the eval $code = $self->_eval_closure( - q{my $attrs = $self->attributes;}, + { '$attrs' => \$self->attributes }, $source ); confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@; diff --git a/lib/Class/MOP/Method/Generated.pm b/lib/Class/MOP/Method/Generated.pm index 9d9a46f..428d808 100644 --- a/lib/Class/MOP/Method/Generated.pm +++ b/lib/Class/MOP/Method/Generated.pm @@ -45,8 +45,17 @@ sub initialize_body { } sub _eval_closure { - my $self = shift; - eval join("\n",@_); + # my ($self, $captures, $sub_body) = @_; + my $__captures = $_[1]; + eval join( + "\n", + (map { + /^([\@\%\$])/ + or die "capture key should start with \@, \% or \$: $_"; + q!my !.$_.q! = !.$1.q!{$__captures->{'!.$_.q!'}};!; + } keys %$__captures), + $_[2] + ); } 1;