From: Jesse Luehrs <doy@tozt.net>
Date: Wed, 30 Jun 2010 04:19:44 +0000 (-0500)
Subject: don't inline accessors unless the instance supports it
X-Git-Tag: 1.09~71
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f001c60fa54f30cb50c8bf6d80f472dca86ea350;p=gitmo%2FMoose.git

don't inline accessors unless the instance supports it
---

diff --git a/Changes b/Changes
index 9fbc6ba..72e4ee8 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,11 @@
 Also see Moose::Manual::Delta for more details of, and workarounds
 for, noteworthy changes.
 
+  [BUG FIXES]
+
+  * Accessors will now not be inlined if the instance metaclass isn't
+    inlinable (doy).
+
 1.08 Tue, Jun 15, 2010
 
   [ENHANCEMENTS]
diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm
index df40c12..7b6517a 100644
--- a/lib/Moose/Meta/Method/Accessor.pm
+++ b/lib/Moose/Meta/Method/Accessor.pm
@@ -111,11 +111,40 @@ sub _value_needs_copy {
     return $attr->should_coerce;
 }
 
-sub _generate_reader_method { shift->_generate_reader_method_inline(@_) }
-sub _generate_writer_method { shift->_generate_writer_method_inline(@_) }
-sub _generate_accessor_method { shift->_generate_accessor_method_inline(@_) }
-sub _generate_predicate_method { shift->_generate_predicate_method_inline(@_) }
-sub _generate_clearer_method { shift->_generate_clearer_method_inline(@_) }
+sub _instance_is_inlinable {
+    my $self = shift;
+    return $self->associated_attribute->associated_class->instance_metaclass->is_inlinable;
+}
+
+sub _generate_reader_method {
+    my $self = shift;
+    $self->_instance_is_inlinable ? $self->_generate_reader_method_inline(@_)
+                                  : $self->SUPER::_generate_reader_method(@_);
+}
+
+sub _generate_writer_method {
+    my $self = shift;
+    $self->_instance_is_inlinable ? $self->_generate_writer_method_inline(@_)
+                                  : $self->SUPER::_generate_writer_method(@_);
+}
+
+sub _generate_accessor_method {
+    my $self = shift;
+    $self->_instance_is_inlinable ? $self->_generate_accessor_method_inline(@_)
+                                  : $self->SUPER::_generate_accessor_method(@_);
+}
+
+sub _generate_predicate_method {
+    my $self = shift;
+    $self->_instance_is_inlinable ? $self->_generate_predicate_method_inline(@_)
+                                  : $self->SUPER::_generate_predicate_method(@_);
+}
+
+sub _generate_clearer_method {
+    my $self = shift;
+    $self->_instance_is_inlinable ? $self->_generate_clearer_method_inline(@_)
+                                  : $self->SUPER::_generate_clearer_method(@_);
+}
 
 sub _inline_pre_body  { '' }
 sub _inline_post_body { '' }
diff --git a/t/020_attributes/033_accessor_inlining.t b/t/020_attributes/033_accessor_inlining.t
new file mode 100644
index 0000000..ed9b60b
--- /dev/null
+++ b/t/020_attributes/033_accessor_inlining.t
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+my $called;
+{
+    package Foo::Meta::Instance;
+    use Moose::Role;
+
+    sub is_inlinable { 0 }
+
+    after get_slot_value => sub { $called++ };
+}
+
+{
+    package Foo;
+    use Moose;
+    Moose::Util::MetaRole::apply_metaroles(
+        for => __PACKAGE__,
+        class_metaroles => {
+            instance => ['Foo::Meta::Instance'],
+        },
+    );
+
+    has foo => (is => 'ro');
+}
+
+my $foo = Foo->new(foo => 1);
+is($foo->foo, 1, "got the right value");
+is($called, 1, "reader was called");
+
+done_testing;