From: Vyacheslav Matyukhin <mmcleric@yandex-team.ru>
Date: Wed, 6 Jun 2012 20:06:49 +0000 (+0400)
Subject: check if default overloads ->()
X-Git-Tag: v0.091010~10
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b02331f2ee6c4c11ff568d1ecad59b896e537d37;p=gitmo%2FMoo.git

check if default overloads ->()
---

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 64bb881..e203179 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -44,12 +44,18 @@ sub generate_method {
     $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)');
   }
   if (exists $spec->{default}) {
-    if (not ref $spec->{default}) {
-      die "Invalid default $spec->{default}";
+    my $default = $spec->{default};
+    require Scalar::Util;
+    if (not ref $default) {
+      die "Invalid default $default";
     }
-    elsif (ref $spec->{default} ne 'CODE') {
-      require Scalar::Util;
-      die "Invalid default $spec->{default}" unless Scalar::Util::blessed $spec->{default};
+    elsif (Scalar::Util::reftype $default ne 'CODE') {
+      if (Scalar::Util::blessed $default) {
+        die "Invalid default $default" unless $default->can('(&{}');
+      }
+      else {
+        die "Invalid default $default";
+      }
     }
   }
 
diff --git a/t/method-generate-accessor.t b/t/method-generate-accessor.t
index cd7741b..7043a4b 100644
--- a/t/method-generate-accessor.t
+++ b/t/method-generate-accessor.t
@@ -27,22 +27,38 @@ like(
 
 like(
   exception { $gen->generate_method('Foo' => 'four' => { is => 'ro', default => 5 }) },
-  qr/Invalid default/, 'default scalar rejected'
+  qr/Invalid default/, 'default - scalar rejected'
 );
 
 like(
   exception { $gen->generate_method('Foo' => 'five' => { is => 'ro', default => [] }) },
-  qr/Invalid default/, 'default arrayref rejected'
+  qr/Invalid default/, 'default - arrayref rejected'
 );
 
 is(
   exception { $gen->generate_method('Foo' => 'six' => { is => 'ro', default => sub { 5 } }) },
-  undef, 'default coderef accepted'
+  undef, 'default - coderef accepted'
 );
 
 is(
   exception { $gen->generate_method('Foo' => 'seven' => { is => 'ro', default => bless sub { 5 } => 'Blah' }) },
-  undef, 'default blessed sub accepted'
+  undef, 'default - blessed sub accepted'
+);
+
+{
+  package WithOverload;
+  use overload '&{}' => sub { sub { 5 } };
+  sub new { bless {} }
+}
+
+is(
+  exception { $gen->generate_method('Foo' => 'eight' => { is => 'ro', default => WithOverload->new }) },
+  undef, 'default - object with overloaded ->() accepted'
+);
+
+like(
+  exception { $gen->generate_method('Foo' => 'nine' => { is => 'ro', default => bless {} => 'Blah' }) },
+  qr/Invalid default/, 'default - object rejected'
 );
 
 my $foo = Foo->new(one => 1);