Generated methods now actually use optimized type constraints, and capture less closu...

diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm
index 22a3eba..22c85f2 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor.pm
+++ b/lib/Moose/Meta/Method/Accessor.pm
@@ -14,6 +14,30 @@ use base 'Moose::Meta::Method',
 
 ## Inline method generators
 
+sub _eval_code {
+    my ( $self, $code ) = @_;
+
+    # NOTE:
+    # set up the environment
+    my $attr        = $self->associated_attribute;
+    my $attr_name   = $attr->name;
+
+    my $type_constraint_obj  = $attr->type_constraint;
+    my $type_constraint_name = $type_constraint_obj && $type_constraint_obj->name;
+    my $type_constraint = $type_constraint_obj
+                                ? (
+                                    $type_constraint_obj->has_hand_optimized_type_constraint
+                                        ? $type_constraint_obj->hand_optimized_type_constraint
+                                        : $type_constraint_obj->_compiled_type_constraint
+                                    )
+                                : undef;
+
+    my $sub = eval $code;
+    confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
+    return $sub;
+
+}
+
 sub generate_accessor_method_inline {
     my $self        = $_[0];
     my $attr        = $self->associated_attribute;
@@ -22,10 +46,7 @@ sub generate_accessor_method_inline {
     my $slot_access = $self->_inline_access($inv, $attr_name);
     my $value_name  = $self->_value_needs_copy ? '$val' : '$_[1]';
 
-    my $type_constraint_obj  = $attr->type_constraint;
-    my $type_constraint_name = $type_constraint_obj && $type_constraint_obj->name;
-
-    my $code = 'sub { ' . "\n"
+    $self->_eval_code('sub { ' . "\n"
     . $self->_inline_pre_body(@_) . "\n"
     . 'if (scalar(@_) >= 2) {' . "\n"
         . $self->_inline_copy_value . "\n"
@@ -38,22 +59,7 @@ sub generate_accessor_method_inline {
     . $self->_inline_check_lazy . "\n"
     . $self->_inline_post_body(@_) . "\n"
     . 'return ' . $self->_inline_auto_deref($self->_inline_get($inv)) . "\n"
-    . ' }';
-
-    # NOTE:
-    # set up the environment
-    my $type_constraint = $attr->type_constraint
-                                ? (
-                                    $attr->type_constraint->has_hand_optimized_type_constraint
-                                        ? $attr->type_constraint->hand_optimized_type_constraint
-                                        : $attr->type_constraint->_compiled_type_constraint
-                                    )
-                                : undef;
-
-    #warn $code;
-    my $sub = eval $code;
-    confess "Could not create accessor for '$attr_name' because $@ \n code: $code" if $@;
-    return $sub;
+    . ' }');
 }
 
 sub generate_writer_method_inline {
@@ -64,7 +70,7 @@ sub generate_writer_method_inline {
     my $slot_access = $self->_inline_get($inv, $attr_name);
     my $value_name  = $self->_value_needs_copy ? '$val' : '$_[1]';
 
-    my $code = 'sub { '
+    $self->_eval_code('sub { '
     . $self->_inline_pre_body(@_)
     . $self->_inline_copy_value
     . $self->_inline_check_required
@@ -73,17 +79,7 @@ sub generate_writer_method_inline {
     . $self->_inline_store($inv, $value_name)
     . $self->_inline_post_body(@_)
     . $self->_inline_trigger($inv, $value_name)
-    . ' }';
-
-    # NOTE:
-    # set up the environment
-    my $type_constraint = $attr->type_constraint
-                                ? $attr->type_constraint->_compiled_type_constraint
-                                : undef;
-
-    my $sub = eval $code;
-    confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
-    return $sub;
+    . ' }');
 }
 
 sub generate_reader_method_inline {
@@ -93,24 +89,13 @@ sub generate_reader_method_inline {
     my $inv         = '$_[0]';
     my $slot_access = $self->_inline_get($inv, $attr_name);
 
-    my $code = 'sub {'
+    $self->_eval_code('sub {'
     . $self->_inline_pre_body(@_)
     . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
     . $self->_inline_check_lazy
     . $self->_inline_post_body(@_)
     . 'return ' . $self->_inline_auto_deref( $slot_access ) . ';'
-    . '}';
-
-    # NOTE:
-    # set up the environment
-    my $type_constraint = $attr->type_constraint
-                                ? $attr->type_constraint->_compiled_type_constraint
-                                : undef;
-
-                                
-    my $sub = eval $code;
-    confess "Could not create reader for '$attr_name' because $@ \n code: $code" if $@;
-    return $sub;
+    . '}');
 }
 
 sub _inline_copy_value {

diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index 0c29027..581e753 100644 (file)
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -88,6 +88,9 @@ sub intialize_body {
         my $attrs = $self->attributes;
 
         my @type_constraints = map { $_->type_constraint } @$attrs;
+        my @type_constraint_bodies = map {
+            $_ && ( $_->has_hand_optimized_type_constraint ? $_->hand_optimized_type_constraint : $_->_compiled_type_constraint );
+        } @type_constraints;
 
         $code = eval $source;
         confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@;
@@ -125,12 +128,10 @@ sub _generate_slot_initializer {
 
             push @source => ('my $val = $params{\'' . $attr->init_arg . '\'};');
             if ($is_moose && $attr->has_type_constraint) {
-                push @source => ('my $type_constraint = $type_constraints[' . $index . '];');
-            
                 if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
-                    push @source => $self->_generate_type_coercion($attr, '$type_constraint', '$val', '$val');
+                    push @source => $self->_generate_type_coercion($attr, '$type_constraints[' . $index . ']', '$val', '$val');
                 }
-                push @source => $self->_generate_type_constraint_check($attr, '$type_constraint', '$val');
+                push @source => $self->_generate_type_constraint_check($attr, '$type_constraint_bodies[' . $index . ']', '$val');
             }
             push @source => $self->_generate_slot_assignment($attr, '$val');
 
@@ -147,7 +148,7 @@ sub _generate_slot_initializer {
             push @source => ('my $val = ' . $default . ';');
             push @source => $self->_generate_type_constraint_check(
                 $attr,
-                ('$type_constraints[' . $index . ']'),
+                ('$type_constraint_bodies[' . $index . ']'),
                 '$val'
             ) if ($is_moose && $attr->has_type_constraint);
             push @source => $self->_generate_slot_assignment($attr, $default);
@@ -159,12 +160,10 @@ sub _generate_slot_initializer {
 
             push @source => ('my $val = $params{\'' . $attr->init_arg . '\'};');
             if ($is_moose && $attr->has_type_constraint) {
-                push @source => ('my $type_constraint = $type_constraints[' . $index . '];');
-
                 if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
-                    push @source => $self->_generate_type_coercion($attr, '$type_constraint', '$val', '$val');
+                    push @source => $self->_generate_type_coercion($attr, '$type_constraints[' . $index . ']', '$val', '$val');
                 }
-                push @source => $self->_generate_type_constraint_check($attr, '$type_constraint', '$val');
+                push @source => $self->_generate_type_constraint_check($attr, '$type_constraint_bodies[' . $index . ']', '$val');
             }
             push @source => $self->_generate_slot_assignment($attr, '$val');
 
@@ -206,9 +205,9 @@ sub _generate_type_coercion {
 }
 
 sub _generate_type_constraint_check {
-    my ($self, $attr, $type_constraint_name, $value_name) = @_;
+    my ($self, $attr, $type_constraint_cv, $value_name) = @_;
     return (
-        'defined(' . $type_constraint_name . '->_compiled_type_constraint->(' . $value_name . '))'
+        $type_constraint_cv . '->(' . $value_name . ')'
         . "\n\t" . '|| confess "Attribute (' . $attr->name . ') does not pass the type constraint ('
         . $attr->type_constraint->name
         . ') with " . (defined(' . $value_name . ') ? (Scalar::Util::blessed(' . $value_name . ') && overload::Overloaded(' . $value_name . ') ? overload::StrVal(' . $value_name . ') : ' . $value_name . ') : "undef");'