Merge branch 'stable'

[gitmo/Class-MOP.git] / lib / Class / MOP / Method / Accessor.pm

diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index 3ce814f..01b3ecf 100644 (file)
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -6,6 +6,7 @@ use warnings;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken';
+use Try::Tiny;
 
 our $VERSION   = '1.12';
 $VERSION = eval $VERSION;
@@ -90,113 +91,148 @@ sub _initialize_body {
 ## generators
 
 sub _generate_accessor_method {
-    my $attr = (shift)->associated_attribute;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
     return sub {
-        $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
+        if (@_ >= 2) {
+            $attr->set_value($_[0], $_[1]);
+        }
         $attr->get_value($_[0]);
     };
 }
 
+sub _generate_accessor_method_inline {
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
+    return try {
+        $self->_compile_code([
+            'sub {',
+                'if (@_ > 1) {',
+                    $attr->_inline_set_value('$_[0]', '$_[1]'),
+                '}',
+                $attr->_inline_get_value('$_[0]'),
+            '}',
+        ]);
+    }
+    catch {
+        confess "Could not generate inline accessor because : $_";
+    };
+}
+
 sub _generate_reader_method {
-    my $attr = (shift)->associated_attribute;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
     return sub {
-        confess "Cannot assign a value to a read-only accessor" if @_ > 1;
+        confess "Cannot assign a value to a read-only accessor"
+            if @_ > 1;
         $attr->get_value($_[0]);
     };
 }
 
+sub _generate_reader_method_inline {
+    my $self = shift;
+    my $attr = $self->associated_attribute;
 
-sub _generate_writer_method {
-    my $attr = (shift)->associated_attribute;
-    return sub {
-        $attr->set_value($_[0], $_[1]);
+    return try {
+        $self->_compile_code([
+            'sub {',
+                'if (@_ > 1) {',
+                    # XXX: this is a hack, but our error stuff is terrible
+                    $self->_inline_throw_error(
+                        '"Cannot assign a value to a read-only accessor"',
+                        'data => \@_'
+                    ) . ';',
+                '}',
+                $attr->_inline_get_value('$_[0]'),
+            '}',
+        ]);
+    }
+    catch {
+        confess "Could not generate inline reader because : $_";
     };
 }
 
-sub _generate_predicate_method {
-    my $attr = (shift)->associated_attribute;
-    return sub {
-        $attr->has_value($_[0])
-    };
+sub _inline_throw_error {
+    my $self = shift;
+    return 'confess ' . $_[0];
 }
 
-sub _generate_clearer_method {
-    my $attr = (shift)->associated_attribute;
+sub _generate_writer_method {
+    my $self = shift;
+    my $attr = $self->associated_attribute;
+
     return sub {
-        $attr->clear_value($_[0])
+        $attr->set_value($_[0], $_[1]);
     };
 }
 
-## Inline methods
-
-sub _generate_accessor_method_inline {
+sub _generate_writer_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    my ( $code, $e ) = $self->_eval_closure(
-        {},
-        'sub {'
-            . $attr->inline_set( '$_[0]', '$_[1]' )
-            . ' if scalar(@_) == 2; '
-            . $attr->inline_get('$_[0]') . '}'
-    );
-    confess "Could not generate inline accessor because : $e" if $e;
-
-    return $code;
+    return try {
+        $self->_compile_code([
+            'sub {',
+                $attr->_inline_set_value('$_[0]', '$_[1]'),
+            '}',
+        ]);
+    }
+    catch {
+        confess "Could not generate inline writer because : $_";
+    };
 }
 
-sub _generate_reader_method_inline {
+sub _generate_predicate_method {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    my ( $code, $e ) = $self->_eval_closure(
-        {},
-        'sub {'
-            . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
-            . $attr->inline_get('$_[0]') . '}'
-    );
-    confess "Could not generate inline reader because : $e" if $e;
-
-    return $code;
+    return sub {
+        $attr->has_value($_[0])
+    };
 }
 
-sub _generate_writer_method_inline {
+sub _generate_predicate_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    my ( $code, $e ) = $self->_eval_closure(
-        {},
-        'sub {' . $attr->inline_set( '$_[0]', '$_[1]' ) . '}'
-    );
-    confess "Could not generate inline writer because : $e" if $e;
-
-    return $code;
+    return try {
+        $self->_compile_code([
+            'sub {',
+                $attr->_inline_has_value('$_[0]'),
+            '}',
+        ]);
+    }
+    catch {
+        confess "Could not generate inline predicate because : $_";
+    };
 }
 
-sub _generate_predicate_method_inline {
+sub _generate_clearer_method {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    my ( $code, $e ) = $self->_eval_closure(
-        {},
-        'sub {' . $attr->inline_has('$_[0]') . '}'
-    );
-    confess "Could not generate inline predicate because : $e" if $e;
-
-    return $code;
+    return sub {
+        $attr->clear_value($_[0])
+    };
 }
 
 sub _generate_clearer_method_inline {
     my $self = shift;
     my $attr = $self->associated_attribute;
 
-    my ( $code, $e ) = $self->_eval_closure(
-        {},
-        'sub {' . $attr->inline_clear('$_[0]') . '}'
-    );
-    confess "Could not generate inline clearer because : $e" if $e;
-
-    return $code;
+    return try {
+        $self->_compile_code([
+            'sub {',
+                $attr->_inline_clear_value('$_[0]'),
+            '}',
+        ]);
+    }
+    catch {
+        confess "Could not generate inline clearer because : $_";
+    };
 }
 
 1;