From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Mon, 8 Oct 2012 17:21:37 +0000 (+0100)
Subject: Include both attribute name and init_arg in constructor errors (RT#79596)
X-Git-Tag: v1.000005~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoo.git;a=commitdiff_plain;h=234f614d04ec3ec8e0b41cbd1713add4ec8910c7

Include both attribute name and init_arg in constructor errors (RT#79596)
---

diff --git a/Changes b/Changes
index 9730665..3092190 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,5 @@
   - fix POD typo (RT#80060)
+  - include init_arg name in constructor errors (RT#79596)
 
 1.000004 - 2012-10-03
   - allow 'has \@attributes' like Moose does
diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index be2ac5f..73ad15d 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -285,10 +285,16 @@ sub generate_coerce {
   ($code, delete $self->{captures});
 }
 
+sub _attr_desc {
+  my ($name, $init_arg) = @_;
+  return perlstring($name) if !defined($init_arg) or $init_arg eq $name;
+  return perlstring($name).' (constructor argument: '.perlstring($init_arg).')';
+}
+
 sub _generate_coerce {
-  my ($self, $name, $value, $coerce) = @_;
+  my ($self, $name, $value, $coerce, $init_arg) = @_;
   $self->_generate_die_prefix(
-    "coercion for ${\perlstring($name)} failed: ",
+    "coercion for ${\_attr_desc($name, $init_arg)} failed: ",
     $self->_generate_call_code($name, 'coerce', "${value}", $coerce)
   );
 }
@@ -324,9 +330,9 @@ sub _generate_die_prefix {
 }
 
 sub _generate_isa_check {
-  my ($self, $name, $value, $check) = @_;
+  my ($self, $name, $value, $check, $init_arg) = @_;
   $self->_generate_die_prefix(
-    "isa check for ${\perlstring($name)} failed: ",
+    "isa check for ${\_attr_desc($name, $init_arg)} failed: ",
     $self->_generate_call_code($name, 'isa_check', $value, $check)
   );
 }
@@ -359,7 +365,7 @@ sub generate_populate_set {
 }
 
 sub _generate_populate_set {
-  my ($self, $me, $name, $spec, $source, $test) = @_;
+  my ($self, $me, $name, $spec, $source, $test, $init_arg) = @_;
   if ($self->has_eager_default($name, $spec)) {
     my $get_indent = ' ' x ($spec->{isa} ? 6 : 4);
     my $get_default = $self->_generate_get_default(
@@ -374,13 +380,13 @@ sub _generate_populate_set {
     if ($spec->{coerce}) {
       $get_value = $self->_generate_coerce(
         $name, $get_value,
-        $spec->{coerce}
+        $spec->{coerce}, $init_arg
       )
     }
     ($spec->{isa}
       ? "    {\n      my \$value = ".$get_value.";\n      "
         .$self->_generate_isa_check(
-          $name, '$value', $spec->{isa}
+          $name, '$value', $spec->{isa}, $init_arg
         ).";\n"
         .'      '.$self->_generate_simple_set($me, $name, $spec, '$value').";\n"
         ."    }\n"
@@ -400,14 +406,14 @@ sub _generate_populate_set {
         ? "      $source = "
           .$self->_generate_coerce(
             $name, $source,
-            $spec->{coerce}
+            $spec->{coerce}, $init_arg
           ).";\n"
         : ""
       )
       .($spec->{isa}
         ? "      "
           .$self->_generate_isa_check(
-            $name, $source, $spec->{isa}
+            $name, $source, $spec->{isa}, $init_arg
           ).";\n"
         : ""
       )
diff --git a/lib/Method/Generate/Constructor.pm b/lib/Method/Generate/Constructor.pm
index bc44372..50a5659 100644
--- a/lib/Method/Generate/Constructor.pm
+++ b/lib/Method/Generate/Constructor.pm
@@ -150,7 +150,7 @@ sub _assign_new {
     my $source = "\$args->{$arg_key}";
     my $attr_spec = $spec->{$_};
     $self->_cap_call($ag->generate_populate_set(
-      '$new', $_, $attr_spec, $source, $test
+      '$new', $_, $attr_spec, $source, $test, $test{$_},
     ));
   } sort keys %test;
 }
diff --git a/t/init-arg.t b/t/init-arg.t
new file mode 100644
index 0000000..d795f6a
--- /dev/null
+++ b/t/init-arg.t
@@ -0,0 +1,75 @@
+use strictures 1;
+use Test::More;
+use Test::Fatal;
+
+{
+  package Foo;
+
+  use Moo;
+
+  has optional => (
+    is => 'rw',
+    init_arg => 'might_have',
+    isa => sub { die "isa" if $_[0] % 2 },
+    default => sub { 7 },
+  );
+
+  has lazy => (
+    is => 'rw',
+    init_arg => 'workshy',
+    isa => sub { die "aieee" if $_[0] % 2 },
+    default => sub { 7 },
+    lazy => 1,
+  );
+}
+
+like(
+  exception { Foo->new },
+  qr/\Aisa check for "optional" \(constructor argument: "might_have"\) failed:/,
+  "isa default"
+);
+
+like(
+  exception { Foo->new(might_have => 3) },
+  qr/\Aisa check for "optional" \(constructor argument: "might_have"\) failed:/,
+  "isa init_arg",
+);
+
+is(
+  exception { Foo->new(might_have => 2) },
+  undef, "isa init_arg ok"
+);
+
+my $foo = Foo->new(might_have => 2);
+
+like(
+  exception { $foo->optional(3) },
+  qr/\Aisa check for "optional" failed:/,
+  "isa accessor",
+);
+
+like(
+  exception { $foo->lazy },
+  qr/\Aisa check for "lazy" failed:/,
+  "lazy accessor",
+);
+
+like(
+  exception { $foo->lazy(3) },
+  qr/\Aisa check for "lazy" failed:/,
+  "lazy set isa fail",
+);
+
+is(
+  exception { $foo->lazy(4) },
+  undef,
+  "lazy set isa ok",
+);
+
+like(
+  exception { Foo->new(might_have => 2, workshy => 3) },
+  qr/\Aisa check for "lazy" \(constructor argument: "workshy"\) failed:/,
+  "lazy init_arg",
+);
+
+done_testing;