From: Yuval Kogman <nothingmuch@woobling.org>
Date: Tue, 18 Dec 2007 04:45:06 +0000 (+0000)
Subject: yay
X-Git-Tag: 0_35~19^2~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7c4f0d321ad4a19bca346b6deb112f0f742dc277;p=gitmo%2FMoose.git

yay
---

diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm
index 4b7a451..6d50849 100644
--- a/lib/Moose/Meta/Method/Accessor.pm
+++ b/lib/Moose/Meta/Method/Accessor.pm
@@ -22,6 +22,9 @@ 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->_inline_pre_body(@_) . "\n"
     . 'if (scalar(@_) == 2) {' . "\n"
@@ -40,7 +43,11 @@ sub generate_accessor_method_inline {
     # NOTE:
     # set up the environment
     my $type_constraint = $attr->type_constraint
-                                ? $attr->type_constraint->_compiled_type_constraint
+                                ? (
+                                    $attr->type_constraint->has_hand_optimized_type_constraint
+                                        ? $attr->type_constraint->hand_optimized_type_constraint
+                                        : $attr->type_constraint->_compiled_type_constraint
+                                    )
                                 : undef;
 
     my $sub = eval $code;
@@ -132,9 +139,9 @@ sub _inline_check_constraint {
     # This sprintf is insanely annoying, we should
     # fix it someday - SL
     return sprintf <<'EOF', $value, $value, $value, $value, $value, $value, $value
-defined($type_constraint->(%s))
-        || confess "Attribute (" . $attr->name . ") does not pass the type constraint ("
-       . $attr->type_constraint->name . ") with "
+$type_constraint->(%s)
+        || confess "Attribute (" . $attr_name . ") does not pass the type constraint ("
+       . $type_constraint_name . ") with "
        . (defined(%s) ? (Scalar::Util::blessed(%s) && overload::Overloaded(%s) ? overload::StrVal(%s) : %s) : "undef")
   if defined(%s);
 EOF
@@ -178,10 +185,10 @@ sub _inline_check_lazy {
                          '        confess(Scalar::Util::blessed('.$inv.')." does not support builder method '.
                          '\'".$attr->builder."\' for attribute \'" . $attr->name . "\'");'. "\n    }";
             }
-            $code .= '    $default = $attr->type_constraint->coerce($default);'."\n"  if $attr->should_coerce;
-            $code .= '    (defined($type_constraint->($default)))' .
-                     '            || confess "Attribute (" . $attr->name . ") does not pass the type constraint ("' .
-                     '           . $attr->type_constraint->name . ") with " . (defined($default) ? (Scalar::Util::blessed($default) && overload::Overloaded($default) ? overload::StrVal($default) : $default) : "undef")' .
+            $code .= '    $default = $type_constraint_obj->coerce($default);'."\n"  if $attr->should_coerce;
+            $code .= '    ($type_constraint->($default))' .
+                     '            || confess "Attribute (" . $attr_name . ") does not pass the type constraint ("' .
+                     '           . $type_constraint_name . ") with " . (defined($default) ? (Scalar::Util::blessed($default) && overload::Overloaded($default) ? overload::StrVal($default) : $default) : "undef")' .
                      '          if defined($default);' . "\n" .
                      '        ' . $slot_access . ' = $default; ' . "\n";
         } 
diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index c0c9671..60973e2 100644
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -87,6 +87,8 @@ sub intialize_body {
         # to be picked up in the eval
         my $attrs = $self->attributes;
 
+        my @type_constraints = map { $_->type_constraint } @$attrs;
+
         $code = eval $source;
         confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@;
     }
@@ -123,7 +125,7 @@ sub _generate_slot_initializer {
 
             push @source => ('my $val = $params{\'' . $attr->init_arg . '\'};');
             if ($is_moose && $attr->has_type_constraint) {
-                push @source => ('my $type_constraint = $attrs->[' . $index . ']->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');
@@ -145,7 +147,7 @@ sub _generate_slot_initializer {
             push @source => ('my $val = ' . $default . ';');
             push @source => $self->_generate_type_constraint_check(
                 $attr,
-                ('$attrs->[' . $index . ']->type_constraint'),
+                ('$type_constraints[' . $index . ']'),
                 '$val'
             ) if ($is_moose && $attr->has_type_constraint);
             push @source => $self->_generate_slot_assignment($attr, $default);
@@ -157,7 +159,7 @@ sub _generate_slot_initializer {
 
             push @source => ('my $val = $params{\'' . $attr->init_arg . '\'};');
             if ($is_moose && $attr->has_type_constraint) {
-                push @source => ('my $type_constraint = $attrs->[' . $index . ']->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');