Merge branch 'master' into method_generation_cleanup

[gitmo/Moose.git] / lib / Moose / Meta / Attribute.pm

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 1f7e017..2e61cdb 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -7,7 +7,7 @@ use warnings;
 use Scalar::Util 'blessed', 'weaken';
 use overload     ();
 
-our $VERSION   = '0.63';
+our $VERSION   = '0.64';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Accessor;
@@ -108,11 +108,24 @@ sub interpolate_class {
     my @traits;
 
     if (my $traits = $options{traits}) {
-        if ( @traits = grep { not $class->does($_) } map {
-            Moose::Util::resolve_metatrait_alias( Attribute => $_ )
-                or
-            $_
-        } @$traits ) {
+        my $i = 0;
+        while ($i < @$traits) {
+            my $trait = $traits->[$i++];
+            next if ref($trait); # options to a trait we discarded
+
+            $trait = Moose::Util::resolve_metatrait_alias(Attribute => $trait)
+                  || $trait;
+
+            next if $class->does($trait);
+
+            push @traits, $trait;
+
+            # are there options?
+            push @traits, $traits->[$i++]
+                if $traits->[$i] && ref($traits->[$i]);
+        }
+
+        if (@traits) {
             my $anon_class = Moose::Meta::Class->create_anon_class(
                 superclasses => [ $class ],
                 roles        => [ @traits ],
@@ -132,6 +145,7 @@ my @legal_options_for_inheritance = qw(
     default coerce required 
     documentation lazy handles 
     builder type_constraint
+    definition_context
 );
 
 sub legal_options_for_inheritance { @legal_options_for_inheritance }
@@ -398,11 +412,7 @@ sub initialize_instance_slot {
         if ($self->should_coerce && $type_constraint->has_coercion) {
             $val = $type_constraint->coerce($val);
         }
-        $type_constraint->check($val)
-            || $self->throw_error("Attribute (" 
-                     . $self->name 
-                     . ") does not pass the type constraint because: " 
-                     . $type_constraint->get_message($val), data => $val, object => $instance);
+        $self->verify_against_type_constraint($val, instance => $instance);
     }
 
     $self->set_initial_value($instance, $val);
@@ -454,11 +464,7 @@ sub _set_initial_slot_value {
         if ($type_constraint) {
             $val = $type_constraint->coerce($val)
                 if $can_coerce;
-            $type_constraint->check($val)
-                || $self->throw_error("Attribute (" 
-                         . $slot_name 
-                         . ") does not pass the type constraint because: " 
-                         . $type_constraint->get_message($val), data => $val, object => $instance);
+            $self->verify_against_type_constraint($val, object => $instance);
         }
         $meta_instance->set_slot_value($instance, $slot_name, $val);
     };
@@ -522,10 +528,7 @@ sub get_value {
                 my $type_constraint = $self->type_constraint;
                 $value = $type_constraint->coerce($value)
                     if ($self->should_coerce);
-                $type_constraint->check($value) 
-                  || $self->throw_error("Attribute (" . $self->name
-                      . ") does not pass the type constraint because: "
-                      . $type_constraint->get_message($value), type_constraint => $type_constraint, data => $value);
+                $self->verify_against_type_constraint($value);
             }
             $self->set_initial_value($instance, $value);
         }
@@ -634,7 +637,7 @@ sub _canonicalize_handles {
         }
         elsif ($handle_type eq 'Regexp') {
             ($self->has_type_constraint)
-                || $self->throw_error("Cannot delegate methods based on a RegExpr without a type constraint (isa)", data => $handles);
+                || $self->throw_error("Cannot delegate methods based on a Regexp without a type constraint (isa)", data => $handles);
             return map  { ($_ => $_) }
                    grep { /$handles/ } $self->_get_delegate_method_list;
         }
@@ -718,6 +721,21 @@ sub _make_delegation_method {
     );
 }
 
+sub verify_against_type_constraint {
+    my $self = shift;
+    my $val  = shift;
+
+    return 1 if !$self->has_type_constraint;
+
+    my $type_constraint = $self->type_constraint;
+
+    $type_constraint->check($val)
+        || $self->throw_error("Attribute ("
+                 . $self->name
+                 . ") does not pass the type constraint because: "
+                 . $type_constraint->get_message($val), data => $val, @_);
+}
+
 package Moose::Meta::Attribute::Custom::Moose;
 sub register_implementation { 'Moose::Meta::Attribute' }
 
@@ -833,6 +851,11 @@ A read-only accessor for this meta-attribute's type constraint. For
 more information on what you can do with this, see the documentation
 for L<Moose::Meta::TypeConstraint>.
 
+=item B<verify_against_type_constraint>
+
+Verifies that the given value is valid under this attribute's type
+constraint, otherwise throws an error.
+
 =item B<has_handles>
 
 Returns true if this meta-attribute performs delegation.