From: Graham Knop <haarg@haarg.org>
Date: Mon, 5 Aug 2013 17:02:36 +0000 (-0400)
Subject: fix deep recursion when calling isa check within isa check
X-Git-Tag: v1.003001~23
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3de68b9f007077841144d63179dc448845a1eed1;p=gitmo%2FMoo.git

fix deep recursion when calling isa check within isa check
---

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 0ba4075..0f71acf 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -21,12 +21,14 @@ BEGIN {
 sub _SIGDIE
 {
   our ($CurrentAttribute, $OrigSigDie);
-  $OrigSigDie ||= sub { die $_[0] };
+  my $sigdie = $OrigSigDie && $OrigSigDie != \&_SIGDIE
+    ? $OrigSigDie
+    : sub { die $_[0] };
   
-  return $OrigSigDie->(@_) if ref($_[0]);
+  return $sigdie->(@_) if ref($_[0]);
   
   my $attr_desc = _attr_desc(@$CurrentAttribute{qw(name init_arg)});
-  $OrigSigDie->("$CurrentAttribute->{step} for $attr_desc failed: $_[0]");
+  $sigdie->("$CurrentAttribute->{step} for $attr_desc failed: $_[0]");
 }
 
 sub _die_overwrite
diff --git a/t/accessor-isa.t b/t/accessor-isa.t
index 8f44500..26d355b 100644
--- a/t/accessor-isa.t
+++ b/t/accessor-isa.t
@@ -154,4 +154,18 @@ is($e->[2], 'isa check', 'step available in isa check');
   is($called, 1, '__DIE__ handler called if set')
 }
 
+{
+  package ClassWithDeadlyIsa;
+  use Moo;
+  has foo => (is => 'ro', isa => sub { die "nope" });
+
+  package ClassUsingDeadlyIsa;
+  use Moo;
+  has bar => (is => 'ro', coerce => sub { ClassWithDeadlyIsa->new(foo => $_[0]) });
+}
+
+like exception { ClassUsingDeadlyIsa->new(bar => 1) },
+  qr/isa check for "foo" failed: nope/,
+  'isa check within isa check produces correct exception';
+
 done_testing;