From: Toby Inkster <mail@tobyinkster.co.uk>
Date: Sat, 15 Jun 2013 00:38:23 +0000 (+0100)
Subject: reimplementation of SIGDIE stuff using a single coderef for the constructor (backed... 
X-Git-Tag: v1.003000~54
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ee03ad214f8ef311fb4fa39d761e2e7b09b7f4fc;p=gitmo%2FMoo.git

reimplementation of SIGDIE stuff using a single coderef for the constructor (backed by some localized variables) rather than one coderef per isa/coerce
---

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 4650b19..1291bcd 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -347,7 +347,9 @@ sub _attr_desc {
 sub _generate_coerce {
   my ($self, $name, $value, $coerce, $init_arg) = @_;
   $self->_generate_die_prefix(
-    "coercion for ${\_attr_desc($name, $init_arg)} failed: ",
+    $name,
+    "coercion",
+    $init_arg,
     $self->_generate_call_code($name, 'coerce', "${value}", $coerce)
   );
 }
@@ -372,12 +374,29 @@ sub generate_isa_check {
 }
 
 sub _generate_die_prefix {
-  my ($self, $prefix, $inside) = @_;
+  my ($self, $name, $prefix, $init_arg, $inside) = @_;
+  
+  $self->{captures}{'$__DIE__'} ||= \ sub {
+    our ($CurrentArgument, $CurrentAttribute, $CurrentStep, $OrigSigDie);
+    $OrigSigDie ||= sub { die $_[0] };
+    
+    $OrigSigDie->(
+      qq[$CurrentStep for "$CurrentAttribute"]
+      . ($CurrentArgument && ($CurrentArgument ne $CurrentAttribute)
+        ? qq[ (constructor argument: "$CurrentArgument")]
+        : "")
+      . qq[ failed: $_[0]]
+    );
+  };
+  
   "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"
+  ."  local \$Method::Generate::Accessor::CurrentArgument = "
+    ."${\B::perlstring($init_arg)};\n"
+  ."  local \$Method::Generate::Accessor::CurrentAttribute = "
+    ."${\B::perlstring($name)};\n"
+  ."  local \$Method::Generate::Accessor::CurrentStep = q[$prefix];\n"
+  .'  local $Method::Generate::Accessor::OrigSigDie = $SIG{__DIE__};'."\n"
+  .'  local $SIG{__DIE__} = $__DIE__;'."\n"
   .$inside
   ."}\n"
 }
@@ -385,7 +404,9 @@ sub _generate_die_prefix {
 sub _generate_isa_check {
   my ($self, $name, $value, $check, $init_arg) = @_;
   $self->_generate_die_prefix(
-    "isa check for ${\_attr_desc($name, $init_arg)} failed: ",
+    $name,
+    "isa check",
+    $init_arg,
     $self->_generate_call_code($name, 'isa_check', $value, $check)
   );
 }