Fix uninit var warning from _inline_create_error when $args is undef
[gitmo/Moose.git] / lib / Moose / Meta / Class.pm
index 1d7cfc6..97901da 100644 (file)
@@ -4,8 +4,8 @@ package Moose::Meta::Class;
 use strict;
 use warnings;
 
+use Class::Load qw(load_class);
 use Class::MOP;
-
 use Carp qw( confess );
 use Data::OptList;
 use List::Util qw( first );
@@ -28,34 +28,40 @@ Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait');
 
 __PACKAGE__->meta->add_attribute('roles' => (
     reader  => 'roles',
-    default => sub { [] }
+    default => sub { [] },
+    Class::MOP::_definition_context(),
 ));
 
 __PACKAGE__->meta->add_attribute('role_applications' => (
     reader  => '_get_role_applications',
-    default => sub { [] }
+    default => sub { [] },
+    Class::MOP::_definition_context(),
 ));
 
 __PACKAGE__->meta->add_attribute(
     Class::MOP::Attribute->new('immutable_trait' => (
         accessor => "immutable_trait",
         default  => 'Moose::Meta::Class::Immutable::Trait',
+        Class::MOP::_definition_context(),
     ))
 );
 
 __PACKAGE__->meta->add_attribute('constructor_class' => (
     accessor => 'constructor_class',
     default  => 'Moose::Meta::Method::Constructor',
+    Class::MOP::_definition_context(),
 ));
 
 __PACKAGE__->meta->add_attribute('destructor_class' => (
     accessor => 'destructor_class',
     default  => 'Moose::Meta::Method::Destructor',
+    Class::MOP::_definition_context(),
 ));
 
 __PACKAGE__->meta->add_attribute('error_class' => (
     accessor => 'error_class',
     default  => 'Moose::Error::Default',
+    Class::MOP::_definition_context(),
 ));
 
 sub initialize {
@@ -136,8 +142,13 @@ sub _anon_cache_key {
                 return;
             }
 
-            $key .= '<' . join('+', 'a', join('%', sort %$alias),
-                                    'e', join('%', sort @$excludes)) . '>';
+            my $alias_key = join('%',
+                map { $_ => $alias->{$_} } sort keys %$alias
+            );
+            my $excludes_key = join('%',
+                sort @$excludes
+            );
+            $key .= '<' . join('+', 'a', $alias_key, 'e', $excludes_key) . '>';
         }
 
         push @role_keys, $key;
@@ -256,14 +267,22 @@ sub new_object {
     my $params = @_ == 1 ? $_[0] : {@_};
     my $object = $self->SUPER::new_object($params);
 
+    $self->_call_all_triggers($object, $params);
+
+    $object->BUILDALL($params) if $object->can('BUILDALL');
+
+    return $object;
+}
+
+sub _call_all_triggers {
+    my ($self, $object, $params) = @_;
+
     foreach my $attr ( $self->get_all_attributes() ) {
 
         next unless $attr->can('has_trigger') && $attr->has_trigger;
 
         my $init_arg = $attr->init_arg;
-
         next unless defined $init_arg;
-
         next unless exists $params->{$init_arg};
 
         $attr->trigger->(
@@ -275,10 +294,6 @@ sub new_object {
             ),
         );
     }
-
-    $object->BUILDALL($params) if $object->can('BUILDALL');
-
-    return $object;
 }
 
 sub _generate_fallback_constructor {
@@ -376,7 +391,8 @@ sub _inline_init_attr_from_constructor {
         '$instance',
         '$params->{\'' . $attr->init_arg . '\'}',
         '$type_constraint_bodies[' . $idx . ']',
-        '$type_constraints[' . $idx . ']',
+        '$type_coercions[' . $idx . ']',
+        '$type_constraint_messages[' . $idx . ']',
         'for constructor',
     );
 
@@ -404,7 +420,8 @@ sub _inline_init_attr_from_default {
             '$instance',
             '$default',
             '$type_constraint_bodies[' . $idx . ']',
-            '$type_constraints[' . $idx . ']',
+            '$type_coercions[' . $idx . ']',
+            '$type_constraint_messages[' . $idx . ']',
             'for constructor',
         ),
     );
@@ -442,7 +459,7 @@ sub _inline_triggers {
 
         push @trigger_calls,
             'if (exists $params->{\'' . $init_arg . '\'}) {',
-                '$attrs->[' . $i . ']->trigger->(',
+                '$triggers->[' . $i . ']->(',
                     '$instance,',
                     $attr->_inline_instance_get('$instance') . ',',
                 ');',
@@ -466,12 +483,69 @@ sub _inline_BUILDALL {
     return @BUILD_calls;
 }
 
+sub _eval_environment {
+    my $self = shift;
+
+    my @attrs = sort { $a->name cmp $b->name } $self->get_all_attributes;
+
+    my $triggers = [
+        map { $_->can('has_trigger') && $_->has_trigger ? $_->trigger : undef }
+            @attrs
+    ];
+
+    # 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;
+
+    my @type_coercions = map {
+        defined $_ && $_->has_coercion
+            ? $_->coercion->_compiled_type_coercion
+            : undef
+    } @type_constraints;
+
+    my @type_constraint_messages = map {
+        defined $_
+            ? ($_->has_message ? $_->message : $_->_default_message)
+            : undef
+    } @type_constraints;
+
+    return {
+        %{ $self->SUPER::_eval_environment },
+        ((any { defined && $_->has_initializer } @attrs)
+            ? ('$attrs' => \[@attrs])
+            : ()),
+        '$triggers' => \$triggers,
+        '@type_coercions' => \@type_coercions,
+        '@type_constraint_bodies' => \@type_constraint_bodies,
+        '@type_constraint_messages' => \@type_constraint_messages,
+        ( map { defined($_) ? %{ $_->inline_environment } : () }
+              @type_constraints ),
+        # pretty sure this is only going to be closed over if you use a custom
+        # error class at this point, but we should still get rid of this
+        # at some point
+        '$meta'  => \$self,
+    };
+}
+
 sub superclasses {
     my $self = shift;
     my $supers = Data::OptList::mkopt(\@_);
     foreach my $super (@{ $supers }) {
         my ($name, $opts) = @{ $super };
-        Class::MOP::load_class($name, $opts);
+        load_class($name, $opts);
         my $meta = Class::MOP::class_of($name);
         $self->throw_error("You cannot inherit from a Moose Role ($name)")
             if $meta && $meta->isa('Moose::Meta::Role')
@@ -672,6 +746,19 @@ sub _immutable_options {
     );
 }
 
+sub _fixup_attributes_after_rebless {
+    my $self = shift;
+    my ($instance, $rebless_from, %params) = @_;
+
+    $self->SUPER::_fixup_attributes_after_rebless(
+        $instance,
+        $rebless_from,
+        %params
+    );
+
+    $self->_call_all_triggers( $instance, \%params );
+}
+
 ## -------------------------------------------------
 
 our $error_level;
@@ -683,8 +770,8 @@ sub throw_error {
 }
 
 sub _inline_throw_error {
-    my ( $self, $msg, $args ) = @_;
-    "\$meta->throw_error($msg" . ($args ? ", $args" : "") . ")"; # FIXME makes deparsing *REALLY* hard
+    my ( $self, @args ) = @_;
+    $self->_inline_raise_error($self->_inline_create_error(@args));
 }
 
 sub raise_error {
@@ -692,6 +779,12 @@ sub raise_error {
     die @args;
 }
 
+sub _inline_raise_error {
+    my ( $self, $message ) = @_;
+
+    return 'die ' . $message;
+}
+
 sub create_error {
     my ( $self, @args ) = @_;
 
@@ -709,7 +802,7 @@ sub create_error {
 
     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 
-    Class::MOP::load_class($class);
+    load_class($class);
 
     $class->new(
         Carp::caller_info($args{depth}),
@@ -717,6 +810,39 @@ sub create_error {
     );
 }
 
+sub _inline_create_error {
+    my ( $self, $msg, $args ) = @_;
+    # XXX ignore $args for now, nothing currently uses it anyway
+
+    require Carp::Heavy;
+
+    my %args = (
+        metaclass  => $self,
+        last_error => $@,
+        message    => $msg,
+    );
+
+    my $class = ref $self ? $self->error_class : "Moose::Error::Default";
+
+    load_class($class);
+
+    # don't check inheritance here - the intention is that the class needs
+    # to provide a non-inherited inlining method, because falling back to
+    # the default inlining method is most likely going to be wrong
+    # yes, this is a huge hack, but so is the entire error system, so.
+    return
+          '$meta->create_error('
+        . $msg
+        . ( defined $args ? ', ' . $args : q{} ) . ');'
+        unless $class->meta->has_method('_inline_new');
+
+    $class->_inline_new(
+        # XXX ignore this for now too
+        # Carp::caller_info($args{depth}),
+        %args
+    );
+}
+
 1;
 
 # ABSTRACT: The Moose metaclass