From: nperez <nperez@cpan.org>
Date: Fri, 26 Jun 2009 00:54:11 +0000 (-0500)
Subject: Make mispelled or unknown additional attribute constructor arguments warn in a very... 
X-Git-Tag: 0.84~11
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=aa4c3a8d5d1cd1e1566a0849219e5181d64e4d59;p=gitmo%2FMoose.git

Make mispelled or unknown additional attribute constructor arguments warn in a very noisy manner
---

diff --git a/Changes b/Changes
index b5b2011..262c345 100644
--- a/Changes
+++ b/Changes
@@ -8,8 +8,10 @@ for, noteworthy changes.
         warning. (hdp)
       - Methods generated by delegation were not being added to
         associated_methods. (hdp)
-      - Attribute accessors (reader, writer, accessor, predicate,
-        clearer) now warn if they overwrite an existing method. (doy)
+      - Attribute accessors (reader, writer, accessor, predicate, clearer) now
+        warn if they overwrite an existing method. (doy)
+      - Attribute constructors now warn very noisily about unknown (or
+        mispelled) arguments
 
     * Moose::Util::TypeConstraints
       - Deprecated the totally useless Role type name, which just
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index d98c6d8..ec52e71 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -77,28 +77,45 @@ sub throw_error {
 sub new {
     my ($class, $name, %options) = @_;
     $class->_process_options($name, \%options) unless $options{__hack_no_process_options}; # used from clone()... YECHKKK FIXME ICKY YUCK GROSS
+    
+    delete $options{__hack_no_process_options};
+
+    my %attrs =
+        ( map { $_ => 1 }
+          grep { defined }
+          map { $_->init_arg() }
+          $class->meta()->get_all_attributes()
+        );
+
+    my @bad = sort grep { ! $attrs{$_} }  keys %options;
+
+    if (@bad)
+    {
+        Carp::cluck "Found unknown argument(s) passed to '$name' attribute constructor in '$class': @bad";
+    }
+
     return $class->SUPER::new($name, %options);
 }
 
 sub interpolate_class_and_new {
-    my ($class, $name, @args) = @_;
+    my ($class, $name, %args) = @_;
 
-    my ( $new_class, @traits ) = $class->interpolate_class(@args);
+    my ( $new_class, @traits ) = $class->interpolate_class(\%args);
 
-    $new_class->new($name, @args, ( scalar(@traits) ? ( traits => \@traits ) : () ) );
+    $new_class->new($name, %args, ( scalar(@traits) ? ( traits => \@traits ) : () ) );
 }
 
 sub interpolate_class {
-    my ($class, %options) = @_;
+    my ($class, $options) = @_;
 
     $class = ref($class) || $class;
 
-    if ( my $metaclass_name = delete $options{metaclass} ) {
+    if ( my $metaclass_name = delete $options->{metaclass} ) {
         my $new_class = Moose::Util::resolve_metaclass_alias( Attribute => $metaclass_name );
 
         if ( $class ne $new_class ) {
             if ( $new_class->can("interpolate_class") ) {
-                return $new_class->interpolate_class(%options);
+                return $new_class->interpolate_class($options);
             } else {
                 $class = $new_class;
             }
@@ -107,7 +124,7 @@ sub interpolate_class {
 
     my @traits;
 
-    if (my $traits = $options{traits}) {
+    if (my $traits = $options->{traits}) {
         my $i = 0;
         while ($i < @$traits) {
             my $trait = $traits->[$i++];
@@ -225,7 +242,7 @@ sub clone_and_inherit_options {
     # so we can ignore it for them.
     # - SL
     if ($self->can('interpolate_class')) {
-        ( $actual_options{metaclass}, my @traits ) = $self->interpolate_class(%options);
+        ( $actual_options{metaclass}, my @traits ) = $self->interpolate_class(\%options);
 
         my %seen;
         my @all_traits = grep { $seen{$_}++ } @{ $self->applied_traits || [] }, @traits;
@@ -244,7 +261,7 @@ sub clone_and_inherit_options {
 sub clone {
     my ( $self, %params ) = @_;
 
-    my $class = $params{metaclass} || ref $self;
+    my $class = delete $params{metaclass} || ref $self;
 
     my ( @init, @non_init );
 
diff --git a/t/020_attributes/001_attribute_reader_generation.t b/t/020_attributes/001_attribute_reader_generation.t
index 6f6a9f2..d6a4183 100644
--- a/t/020_attributes/001_attribute_reader_generation.t
+++ b/t/020_attributes/001_attribute_reader_generation.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 13;
+use Test::More tests => 14;
 use Test::Exception;
 
 
@@ -27,6 +27,16 @@ use Test::Exception;
         );
     };
     ::ok(!$@, '... created the lazy reader method okay') or warn $@;
+
+    my $warn;
+
+    eval {
+        local $SIG{__WARN__} = sub { $warn = $_[0] };
+        has 'mtfnpy' => (
+            reder => 'get_mftnpy'
+        );
+    };
+    ::ok($warn, '... got a warning for mispelled attribute argument');
 }
 
 {