stop closing over the method metaobject

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

diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm
index 96e6143..9c9b858 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor.pm
+++ b/lib/Moose/Meta/Method/Accessor.pm
@@ -6,11 +6,18 @@ use warnings;
 
 use Try::Tiny;
 
-our $AUTHORITY = 'cpan:STEVAN';
-
 use base 'Moose::Meta::Method',
          'Class::MOP::Method::Accessor';
 
+# multiple inheritance is terrible
+sub new {
+    goto &Class::MOP::Method::Accessor::new;
+}
+
+sub _new {
+    goto &Class::MOP::Method::Accessor::_new;
+}
+
 sub _error_thrower {
     my $self = shift;
     return $self->associated_attribute
@@ -37,19 +44,41 @@ sub _compile_code {
 sub _eval_environment {
     my $self = shift;
 
-    my $attr                = $self->associated_attribute;
-    my $type_constraint_obj = $attr->type_constraint;
-
-    return {
-        '$attr'                => \$attr,
-        '$meta'                => \$self,
-        '$type_constraint_obj' => \$type_constraint_obj,
-        '$type_constraint'     => \(
-              $type_constraint_obj
-                  ? $type_constraint_obj->_compiled_type_constraint
-                  : undef
-        ),
-    };
+    my $env = { };
+
+    my $attr = $self->associated_attribute;
+
+    $env->{'$trigger'} = \($attr->trigger)
+        if $attr->has_trigger;
+    $env->{'$default'} = \($attr->default)
+        if $attr->has_default;
+
+    if ($attr->has_type_constraint) {
+        my $tc_obj = $attr->type_constraint;
+
+        # is this going to be an issue? it's currently only used for the tc
+        # message. is there a way to inline that too?
+        $env->{'$type_constraint_obj'} = \$tc_obj;
+
+        $env->{'$type_constraint'} = \(
+            $tc_obj->_compiled_type_constraint
+        ) unless $tc_obj->can_be_inlined;
+        $env->{'$type_coercion'} = \(
+            $tc_obj->coercion->_compiled_type_coercion
+        ) if $tc_obj->has_coercion;
+
+        $env = { %$env, %{ $tc_obj->inline_environment } };
+    }
+
+    # XXX ugh, fix these
+    $env->{'$attr'} = \$attr
+        if $attr->has_initializer && $attr->is_lazy;
+    # 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
+    $env->{'$meta'} = \($self->associated_metaclass);
+
+    return $env;
 }
 
 sub _instance_is_inlinable {
@@ -95,6 +124,10 @@ sub _inline_tc_code {
     shift->associated_attribute->_inline_tc_code(@_);
 }
 
+sub _inline_check_coercion {
+    shift->associated_attribute->_inline_check_coercion(@_);
+}
+
 sub _inline_check_constraint {
     shift->associated_attribute->_inline_check_constraint(@_);
 }