test for BUILDARGS
Yuval Kogman [Thu, 26 Jun 2008 08:58:54 +0000 (08:58 +0000)]
lib/Moose/Meta/Method/Constructor.pm
t/300_immutable/009_buildargs.t [new file with mode: 0644]

index 1012d08..6c37c14 100644 (file)
@@ -125,7 +125,7 @@ sub _generate_BUILDARGS {
 
     my $buildargs = $self->associated_metaclass->find_method_by_name("BUILDARGS");
 
-    if ( !$buildargs || $buildargs->body == \&Moose::Object::BUILDARGS and $args eq '@_') {
+    if ( $args eq '@_' and ( !$buildargs or $buildargs->body == \&Moose::Object::BUILDARGS ) ) {
         return join("\n",
             'do {',
             'confess "Single parameters to new() must be a HASH ref"',
diff --git a/t/300_immutable/009_buildargs.t b/t/300_immutable/009_buildargs.t
new file mode 100644 (file)
index 0000000..e1a3016
--- /dev/null
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+{
+    package Foo;
+    use Moose;
+
+    has bar => ( is => "rw" );
+
+    sub BUILDARGS {
+        my ( $self, @args ) = @_;
+        unshift @args, "bar" if @args % 2 == 1;
+        return {@args};
+    }
+
+    package Bar;
+    use Moose;
+
+    extends qw(Foo);
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+foreach my $class qw(Foo Bar) {
+    is( $class->new->bar, undef, "no args" );
+    is( $class->new( bar => 42 )->bar, 42, "normal args" );
+    is( $class->new( 37 )->bar, 37, "single arg" );
+}