fix deep recursion when calling isa check within isa check
Graham Knop [Mon, 5 Aug 2013 17:02:36 +0000 (13:02 -0400)]
lib/Method/Generate/Accessor.pm
t/accessor-isa.t

index 0ba4075..0f71acf 100644 (file)
@@ -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
index 8f44500..26d355b 100644 (file)
@@ -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;