Handle Foo->new(undef) consistently, with an error saying a single param to new(...

diff --git a/Changes b/Changes
index 72bc4e8..de49090 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,13 @@
 Revision history for Perl extension Moose
 
+0.72
+    * Moose::Object
+    * Moose::Meta::Method::Constructor
+      - A mutable class accepted Foo->new(undef) without complaint,
+        while an immutable class would blow up with an unhelpful
+        error. Now, in both cases we throw a helpful error
+        instead. Reported by doy.
+
 0.71_01 Sun, February 22, 2009
     * Moose::Cookbook
       - Hopefully fixed some POD errors in a few recipes that caused

diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm
index 548de1f..9d8fc18 100644 (file)
--- a/lib/Moose/Meta/Method/Constructor.pm
+++ b/lib/Moose/Meta/Method/Constructor.pm
@@ -177,7 +177,7 @@ sub initialize_body {
             '@type_constraint_bodies' => \@type_constraint_bodies,
         },
     ) or $self->throw_error("Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@", error => $@, data => $source );
-
+    
     $self->{'body'} = $code;
 }
 
@@ -190,7 +190,7 @@ sub _generate_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]) ne q{HASH};',
+            '    if scalar @_ == 1 && !( defined $_[0] && ref $_[0] eq q{HASH} );',
             '(scalar @_ == 1) ? {%{$_[0]}} : {@_};',
             '}',
         );

diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm
index 24528ad..afe2ba7 100644 (file)
--- a/lib/Moose/Object.pm
+++ b/lib/Moose/Object.pm
@@ -21,16 +21,14 @@ sub new {
 
 sub BUILDARGS {
     my $class = shift;
-    if (scalar @_ == 1) {
-        if (defined $_[0]) {
-            (ref($_[0]) eq 'HASH')
-                || $class->meta->throw_error("Single parameters to new() must be a HASH ref", data => $_[0]);
-            return {%{$_[0]}};
-        } 
-        else {
-            return {}; # FIXME this is compat behavior, but is it correct?
+    if ( scalar @_ == 1 ) {
+        unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
+            $class->meta->throw_error(
+                "Single parameters to new() must be a HASH ref",
+                data => $_[0] );
         }
-    } 
+        return { %{ $_[0] } };
+    }
     else {
         return {@_};
     }

diff --git a/t/010_basics/017_error_handling.t b/t/010_basics/017_error_handling.t
index 081ced0..4250c02 100644 (file)
--- a/t/010_basics/017_error_handling.t
+++ b/t/010_basics/017_error_handling.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2;
+use Test::More tests => 3;
 use Test::Exception;
 
 # This tests the error handling in Moose::Object only
@@ -15,6 +15,8 @@ use Test::Exception;
 
 throws_ok { Foo->new('bad') } qr/^\QSingle parameters to new() must be a HASH ref/,
           'A single non-hashref arg to a constructor throws an error';
+throws_ok { Foo->new(undef) } qr/^\QSingle parameters to new() must be a HASH ref/,
+          'A single non-hashref arg to a constructor throws an error';
 
 throws_ok { Foo->does() } qr/^\QYou much supply a role name to does()/,
           'Cannot call does() without a role name';

diff --git a/t/100_bugs/008_new_w_undef.t b/t/100_bugs/008_new_w_undef.t
deleted file mode 100644 (file)
index 4001dc3..0000000
--- a/t/100_bugs/008_new_w_undef.t
+++ /dev/null
@@ -1,21 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 1;
-use Test::Exception;
-
-{
-    package Foo;
-    use Moose;    
-    has 'foo' => ( is => 'ro' );
-}
-
-lives_ok {
-    Foo->new(undef);
-} '... passing in undef just gets ignored';
-
-
-
-

diff --git a/t/100_bugs/011_DEMOLISH_eats_exceptions.t b/t/100_bugs/011_DEMOLISH_eats_exceptions.t
index f785283..5813892 100644 (file)
--- a/t/100_bugs/011_DEMOLISH_eats_exceptions.t
+++ b/t/100_bugs/011_DEMOLISH_eats_exceptions.t
@@ -116,7 +116,7 @@ sub check_em {
      }
      {
          local $@;        
-         my $obj = eval { $pkg->new ( undef ); };
+         my $obj = eval { $pkg->new ( notanattr => 1 ); };
          ::like( $@, qr/is required/, "... $pkg undef" );
          ::is( $obj, undef, "... the object is undef" );
      }

diff --git a/t/300_immutable/008_immutable_constructor_error.t b/t/300_immutable/008_immutable_constructor_error.t
index 62d6d3c..7d5140d 100644 (file)
--- a/t/300_immutable/008_immutable_constructor_error.t
+++ b/t/300_immutable/008_immutable_constructor_error.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2;
+use Test::More tests => 3;
 use Test::Exception;
 
 
@@ -30,4 +30,6 @@ throws_ok { Foo->new($scalar) } qr/\QSingle parameters to new() must be a HASH r
           'Non-ref provided to immutable constructor gives useful error message';
 throws_ok { Foo->new(\$scalar) } qr/\QSingle parameters to new() must be a HASH ref/,
           'Scalar ref provided to immutable constructor gives useful error message';
+throws_ok { Foo->new(undef) } qr/\QSingle parameters to new() must be a HASH ref/,
+          'undef provided to immutable constructor gives useful error message';