(no commit message)

[gitmo/Moose.git] / lib / Moose / Meta / Method / Constructor.pm

diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index ae65438..24c845d 100644 (file)
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -7,7 +7,7 @@ use warnings;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
 
-our $VERSION   = '0.03';
+our $VERSION   = '0.05';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Moose::Meta::Method',
@@ -87,6 +87,23 @@ sub intialize_body {
         # 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;
         confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@;
     }
@@ -123,29 +140,27 @@ 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;');
-
                 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');
 
-
         push @source => "} else {";
 
             my $default;
-            if( $attr->has_default ){
+            if ( $attr->has_default ) {
                 $default = $self->_generate_default_value($attr, $index);
-            } else {
+            } 
+            else {
                my $builder = $attr->builder;
                $default = '$instance->' . $builder;
             }
             push @source => ('my $val = ' . $default . ';');
             push @source => $self->_generate_type_constraint_check(
                 $attr,
-                ('$attrs->[' . $index . ']->type_constraint'),
+                ('$type_constraint_bodies[' . $index . ']'),
                 '$val'
             ) if ($is_moose && $attr->has_type_constraint);
             push @source => $self->_generate_slot_assignment($attr, $default);
@@ -157,12 +172,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 = $attrs->[' . $index . ']->type_constraint;');
-
                 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');
 
@@ -204,12 +217,12 @@ 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");'
+        . ') with " . (defined(' . $value_name . ') ? overload::StrVal(' . $value_name . ') : "undef");'
     );
 }
 
@@ -276,7 +289,7 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>