From: Alex J. G. Burzyński <ajgb@cpan.org>
Date: Thu, 19 May 2011 22:28:03 +0000 (+0200)
Subject: pass coerce tests
X-Git-Tag: release_0.009009~14
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=82a5b14633cd191acbfa31c8ace0569baa85183a;p=gitmo%2FRole-Tiny.git

pass coerce tests
---

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index c8c6b49..65173ef 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -130,7 +130,7 @@ sub is_simple_attribute {
   # clearer doesn't have to be listed because it doesn't
   # affect whether defined/exists makes a difference
   !grep $spec->{$_},
-    qw(lazy default builder isa trigger predicate weak_ref);
+    qw(lazy default builder coerce isa trigger predicate weak_ref);
 }
 
 sub is_simple_get {
@@ -140,7 +140,7 @@ sub is_simple_get {
 
 sub is_simple_set {
   my ($self, $name, $spec) = @_;
-  !grep $spec->{$_}, qw(isa trigger weak_ref);
+  !grep $spec->{$_}, qw(coerce isa trigger weak_ref);
 }
 
 sub has_eager_default {
@@ -203,9 +203,14 @@ sub _generate_set {
   if ($self->is_simple_set($name, $spec)) {
     $self->_generate_simple_set('$_[0]', $name, $spec, '$_[1]');
   } else {
-    my ($trigger, $isa_check) = @{$spec}{qw(trigger isa)};
+    my ($coerce, $trigger, $isa_check) = @{$spec}{qw(coerce trigger isa)};
     my $simple = $self->_generate_simple_set('$self', $name, $spec, '$value');
     my $code = "do { my (\$self, \$value) = \@_;\n";
+    if ($coerce) {
+      $code .=
+        "        \$value = "
+        .$self->_generate_coerce($name, '$self', '$value', $coerce).";\n";
+    }
     if ($isa_check) {
       $code .= 
         "        ".$self->_generate_isa_check($name, '$value', $isa_check).";\n";
@@ -222,7 +227,19 @@ sub _generate_set {
     $code;
   }
 }
-  
+
+sub generate_coerce {
+  my $self = shift;
+  $self->{captures} = {};
+  my $code = $self->_generate_coerce(@_);
+  ($code, delete $self->{captures});
+}
+
+sub _generate_coerce {
+  my ($self, $name, $obj, $value, $coerce) = @_;
+  $self->_generate_call_code($name, 'coerce', "${value}", $coerce);
+}
+ 
 sub generate_trigger {
   my $self = shift;
   $self->{captures} = {};
@@ -307,6 +324,14 @@ sub _generate_populate_set {
     );
   } else {
     "    if (${test}) {\n"
+      .($spec->{coerce}
+        ? "      $source = "
+          .$self->_generate_coerce(
+            $name, $me, $source,
+            $spec->{coerce}
+          ).";\n"
+        : ""
+      )
       .($spec->{isa}
         ? "      "
           .$self->_generate_isa_check(