localize @_ when inlining quote_sub'ed isa checks (fixes lazy+isa+default)

[gitmo/Moo.git] / lib / Method / Generate / Accessor.pm

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 0918912..7089056 100644 (file)
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -284,7 +284,10 @@ sub generate_coerce {
 
 sub _generate_coerce {
   my ($self, $name, $value, $coerce) = @_;
-  $self->_generate_call_code($name, 'coerce', "${value}", $coerce);
+  $self->_generate_die_prefix(
+    "coercion for ${\perlstring($name)} failed: ",
+    $self->_generate_call_code($name, 'coerce', "${value}", $coerce)
+  );
 }
  
 sub generate_trigger {
@@ -306,24 +309,37 @@ sub generate_isa_check {
   ($code, delete $self->{captures});
 }
 
+sub _generate_die_prefix {
+  my ($self, $prefix, $inside) = @_;
+  "do {\n"
+  .'  my $sig_die = $SIG{__DIE__} || sub { die $_[0] };'."\n"
+  .'  local $SIG{__DIE__} = sub {'."\n"
+  .'    $sig_die->(ref($_[0]) ? $_[0] : '.perlstring($prefix).'.$_[0]);'."\n"
+  .'  };'."\n"
+  .$inside
+  ."}\n"
+}
+
 sub _generate_isa_check {
   my ($self, $name, $value, $check) = @_;
-  $self->_generate_call_code($name, 'isa_check', $value, $check);
+  $self->_generate_die_prefix(
+    "isa check for ${\perlstring($name)} failed: ",
+    $self->_generate_call_code($name, 'isa_check', $value, $check)
+  );
 }
 
 sub _generate_call_code {
   my ($self, $name, $type, $values, $sub) = @_;
   if (my $quoted = quoted_from_sub($sub)) {
     my $code = $quoted->[1];
-    my $at_ = '@_ = ('.$values.');';
     if (my $captures = $quoted->[2]) {
       my $cap_name = qq{\$${type}_captures_for_${name}};
       $self->{captures}->{$cap_name} = \$captures;
       Sub::Quote::inlinify(
-        $code, $values, Sub::Quote::capture_unroll($cap_name, $captures, 6)
+        $code, $values, Sub::Quote::capture_unroll($cap_name, $captures, 6), 1
       );
     } else {
-      Sub::Quote::inlinify($code, $values);
+      Sub::Quote::inlinify($code, $values, undef, 1);
     }
   } else {
     my $cap_name = qq{\$${type}_for_${name}};