From: Graham Knop <haarg@haarg.org>
Date: Fri, 1 Mar 2013 10:09:04 +0000 (-0500)
Subject: allow non-ref defaults
X-Git-Tag: v1.001000~17
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2a894d0c5d6add296846e53d37ec42661ec34ef5;p=gitmo%2FMoo.git

allow non-ref defaults
---

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 3901043..3f2fa4a 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -60,10 +60,9 @@ sub generate_method {
     $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)');
   }
 
-  for my $setting (qw( default coerce )) {
-    next if !exists $spec->{$setting};
-    my $value = $spec->{$setting};
-    my $invalid = "Invalid $setting '" . overload::StrVal($value)
+  if (exists $spec->{coerce}) {
+    my $value = $spec->{coerce};
+    my $invalid = "Invalid coerce '" . overload::StrVal($value)
       . "' for $into->$name - not a coderef";
     die "$invalid or code-convertible object"
       unless ref $value and (ref $value eq 'CODE' or blessed($value));
@@ -71,6 +70,19 @@ sub generate_method {
       if !eval { \&$value };
   }
 
+  if (exists $spec->{default}) {
+    my $value = $spec->{default};
+    if (!defined $value || ref $value) {
+      my $invalid = "Invalid default '" . overload::StrVal($value)
+        . "' for $into->$name - not a coderef or non-ref";
+      die "$invalid or code-convertible object"
+        unless ref $value and (ref $value eq 'CODE' or blessed($value));
+      die "$invalid and could not be converted to a coderef: $@"
+        if !eval { \&$value };
+    }
+  }
+
+
   my %methods;
   if (my $reader = $spec->{reader}) {
     if (our $CAN_HAZ_XS && $self->is_simple_get($name, $spec)) {
@@ -254,9 +266,14 @@ sub _generate_use_default {
 
 sub _generate_get_default {
   my ($self, $me, $name, $spec) = @_;
-  $spec->{default}
-    ? $self->_generate_call_code($name, 'default', $me, $spec->{default})
-    : "${me}->${\$spec->{builder}}"
+  if (exists $spec->{default}) {
+    ref $spec->{default}
+      ? $self->_generate_call_code($name, 'default', $me, $spec->{default})
+      : perlstring $spec->{default};
+  }
+  else {
+    "${me}->${\$spec->{builder}}"
+  }
 }
 
 sub generate_simple_get {
diff --git a/t/accessor-default.t b/t/accessor-default.t
index fd1108b..58eac3e 100644
--- a/t/accessor-default.t
+++ b/t/accessor-default.t
@@ -22,6 +22,7 @@ my $c_ran;
   sub _build_eight { {} }
   has nine => (is => 'lazy', coerce => sub { $c_ran = 1; $_[0] });
   sub _build_nine { {} }
+  has ten => (is => 'lazy', default => 5 );
 }
 
 sub check {
@@ -54,4 +55,6 @@ $c_ran = 0;
 check nine => map Foo->new->nine, 1..2;
 ok($c_ran, 'coerce lazy default');
 
+is(Foo->new->ten, 5, 'non-ref default');
+
 done_testing;
diff --git a/t/method-generate-accessor.t b/t/method-generate-accessor.t
index 64dbfee..6da7e99 100644
--- a/t/method-generate-accessor.t
+++ b/t/method-generate-accessor.t
@@ -32,12 +32,18 @@ like(
   qr/Unknown is purple/, 'is purple rejected'
 );
 
-for my $setting (qw( default coerce )) {
-  like(
-    exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', $setting => 5 }) },
-    qr/Invalid $setting/, "$setting - scalar rejected"
-  );
+like(
+  exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', coerce => 5 }) },
+  qr/Invalid coerce/, "coerce - scalar rejected"
+);
 
+is(
+  exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', default => 5 }) },
+  undef, "default - non-ref scalar accepted"
+);
+
+
+for my $setting (qw( default coerce )) {
   like(
     exception { $gen->generate_method('Foo' => 'five' => { is => 'ro', $setting => [] }) },
     qr/Invalid $setting/, "$setting - arrayref rejected"