From: Dave Rolsky <autarch@urth.org>
Date: Sun, 17 Oct 2010 15:16:23 +0000 (-0500)
Subject: Add explicit check for odd number of args to new and give a useful warning
X-Git-Tag: 1.16~23^2~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0d922627c71aad7f8ad45216a4b43f713f0a4a6f;p=gitmo%2FMoose.git

Add explicit check for odd number of args to new and give a useful warning
---

diff --git a/Changes b/Changes
index 8c7cf41..6ea77d8 100644
--- a/Changes
+++ b/Changes
@@ -13,6 +13,10 @@ NEXT
     what arguments each native delegation method allows or requires. (Dave
     Rolsky)
 
+  * Passing an odd number of args to ->new() now gives a more useful warning
+    than Perl's builtin warning. Suggested by Sir Robert Burbridge. (Dave
+    Rolsky)
+
   [BUG FIXES]
 
   * A number of native trait methods which expected strings as arguments did
diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index e64e9db..fc043e7 100644
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -4,6 +4,7 @@ package Moose::Meta::Method::Constructor;
 use strict;
 use warnings;
 
+use Carp ();
 use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
 
 our $VERSION   = '1.15';
@@ -144,15 +145,34 @@ sub _generate_BUILDARGS {
 
     my $buildargs = $self->associated_metaclass->find_method_by_name("BUILDARGS");
 
-    if ( $args eq '@_' and ( !$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS ) ) {
-        return join("\n",
-            'do {',
-            $self->_inline_throw_error('"Single parameters to new() must be a HASH ref"', 'data => $_[0]'),
-            '    if scalar @_ == 1 && !( defined $_[0] && ref $_[0] eq q{HASH} );',
-            '(scalar @_ == 1) ? {%{$_[0]}} : {@_};',
-            '}',
-        );
-    } else {
+    if ( $args eq '@_'
+        and ( !$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS )
+        ) {
+
+        # This is basically a copy of Moose::Object::BUILDARGS wrapped in a do
+        # {} block.
+        return sprintf( <<'EOF', $self->_inline_throw_error( q{'Single parameters to new() must be a HASH ref'}, 'data => $_[0]' ) );
+do {
+    if ( scalar @_ == 1 ) {
+        unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
+            %s
+        }
+        return { %%{ $_[0] } };
+    }
+    elsif ( @_ %% 2 ) {
+        Carp::carp(
+            "The new() method for $class expects a hash reference or a key/value list."
+                . " You passed an odd number of arguments" );
+        return { @_, undef };
+    }
+    else {
+        return {@_};
+    }
+};
+EOF
+            ;
+    }
+    else {
         return $class . "->BUILDARGS($args)";
     }
 }
diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm
index b8f02c9..1896b06 100644
--- a/lib/Moose/Object.pm
+++ b/lib/Moose/Object.pm
@@ -4,6 +4,7 @@ package Moose::Object;
 use strict;
 use warnings;
 
+use Carp ();
 use Devel::GlobalDestruction ();
 use MRO::Compat ();
 use Scalar::Util ();
@@ -35,6 +36,12 @@ sub BUILDARGS {
         }
         return { %{ $_[0] } };
     }
+    elsif ( @_ % 2 ) {
+        Carp::carp(
+            "The new() method for $class expects a hash reference or a key/value list."
+                . " You passed an odd number of arguments" );
+        return { @_, undef };
+    }
     else {
         return {@_};
     }
diff --git a/t/010_basics/022_buildargs_warning.t b/t/010_basics/022_buildargs_warning.t
new file mode 100644
index 0000000..f9cd94c
--- /dev/null
+++ b/t/010_basics/022_buildargs_warning.t
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Moose qw( with_immutable );
+
+use Test::Requires {
+    'Test::Output' => '0.01',
+};
+
+{
+    package Baz;
+    use Moose;
+}
+
+with_immutable {
+    stderr_like { Baz->new( x => 42, 'y' ) }
+    qr{\QThe new() method for Baz expects a hash reference or a key/value list. You passed an odd number of arguments at t/010_basics/022_buildargs_warning.t line \E\d+},
+        'warning when passing an odd number of args to new()';
+
+    stderr_unlike { Baz->new( x => 42, 'y' ) }
+    qr{\QOdd number of elements in anonymous hash},
+        'we suppress the standard warning from Perl for an odd number of elements in a hash';
+}
+'Baz';
+
+done_testing;