Handle uninlinable instance in native trait code generation
Dave Rolsky [Sun, 26 Sep 2010 16:27:58 +0000 (11:27 -0500)]
lib/Moose/Meta/Attribute/Native/Trait.pm
lib/Moose/Meta/Method/Accessor/Native.pm
lib/Moose/Meta/Method/Accessor/Native/Writer.pm

index 190abb0..ee44d6d 100644 (file)
@@ -89,6 +89,7 @@ around '_make_delegation_method' => sub {
         name              => $handle_name,
         package_name      => $self->associated_class->name,
         attribute         => $self,
+        is_inline         => 1,
         curried_arguments => \@curried_args,
         root_types        => [ $self->_root_types ],
     );
index a57e5ff..62cde0f 100644 (file)
@@ -68,16 +68,6 @@ sub _initialize_body {
     return;
 }
 
-sub _eval_environment {
-    my $self = shift;
-
-    my $env = $self->SUPER::_eval_environment;
-
-    $env->{'@curried'} = $self->curried_arguments;
-
-    return $env;
-}
-
 sub _inline_curried_arguments {
     my $self = shift;
 
@@ -127,4 +117,48 @@ sub _maximum_arguments { undef }
 
 sub _inline_check_arguments { q{} }
 
+sub _inline_get {
+    my ( $self, $instance ) = @_;
+
+    return $self->_slot_access_can_be_inlined
+        ? $self->SUPER::_inline_get($instance)
+        : "${instance}->\$reader";
+}
+
+sub _inline_store {
+    my ( $self, $instance, $value ) = @_;
+
+    return $self->_slot_access_can_be_inlined
+        ? $self->SUPER::_inline_store( $instance, $value )
+        : "${instance}->\$writer($value)";
+}
+
+sub _eval_environment {
+    my $self = shift;
+
+    my $env = $self->SUPER::_eval_environment(@_);
+
+    $env->{'@curried'} = $self->curried_arguments;
+
+    return $env if $self->_slot_access_can_be_inlined;
+
+    my $reader = $self->associated_attribute->get_read_method_ref;
+    $reader = $reader->body if blessed $reader;
+
+    $env->{'$reader'} = \$reader;
+
+    my $writer = $self->associated_attribute->get_write_method_ref;
+    $writer = $writer->body if blessed $writer;
+
+    $env->{'$writer'} = \$writer;
+
+    return $env;
+}
+
+sub _slot_access_can_be_inlined {
+    my $self = shift;
+
+    return $self->is_inline && $self->_instance_is_inlinable;
+}
+
 1;
index c140acb..f44aac4 100644 (file)
@@ -144,7 +144,7 @@ sub _inline_set_new_value {
     my $self = shift;
 
     return $self->SUPER::_inline_store(@_)
-        if $self->_value_needs_copy;
+        if $self->_value_needs_copy || !$self->_slot_access_can_be_inlined;
 
     return $self->_inline_optimized_set_new_value(@_);
 }