From: Stevan Little <stevan.little@iinteractive.com>
Date: Wed, 2 Jul 2008 16:46:41 +0000 (+0000)
Subject: some changes, seee changes for details
X-Git-Tag: 0_55~60
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=977a86ba7f5490f495bad70160514ce204069f5b;p=gitmo%2FMoose.git

some changes, seee changes for details
---

diff --git a/Changes b/Changes
index 2af4daf..d57d754 100644
--- a/Changes
+++ b/Changes
@@ -4,16 +4,23 @@ Revision history for Perl extension Moose
     * Moose::Cookbook::Snacks::*
       - removed some of the unfinished snacks that should 
         not have been released yet. Added some more examples
-        and explination to the 'Keywords' snack. (Stevan)
+        and explination to the 'Keywords' snack. (stevan)
     
     * Moose
       - added "FEATURE REQUESTS" section to the Moose docs
-        to properly direct people (Stevan) (RT #34333)
+        to properly direct people (stevan) (RT #34333)
+      - making 'extends' croak if it is passed a Role since 
+        this is not ever something you want to do 
+        (fixed by stevan, found by obra)
+        - added tests for this (stevan)
 
     * Moose::Cookbook::Style
       - added general Moose "style guide" of sorts to the 
         cookbook (nothingmuch) (RT #34335)
 
+    * t/
+      - added more BUILDARGS tests (stevan)
+
 0.51 Thurs. Jun 26, 2008
     * Moose::Role
       - add unimport so "no Moose::Role" actually does
diff --git a/lib/Moose.pm b/lib/Moose.pm
index f4cd595..9c14ff1 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -84,8 +84,14 @@ use Moose::Util ();
                 my @supers = @_;
                 foreach my $super (@supers) {
                     Class::MOP::load_class($super);
+                    croak "You cannot inherit from a Moose Role ($super)"
+                        if $super->can('meta')  && 
+                           blessed $super->meta &&
+                           $super->meta->isa('Moose::Meta::Role')
                 }
 
+
+
                 # this checks the metaclass to make sure
                 # it is correct, sometimes it can get out
                 # of sync when the classes are being built
diff --git a/t/010_basics/015_buildargs.t b/t/010_basics/015_buildargs.t
new file mode 100644
index 0000000..bff4aeb
--- /dev/null
+++ b/t/010_basics/015_buildargs.t
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 14;
+
+{
+    package Foo;
+    use Moose;
+
+    has bar => ( is => "rw" );
+    has baz => ( is => "rw" );    
+
+    sub BUILDARGS {
+        my ( $self, @args ) = @_;
+        unshift @args, "bar" if @args % 2 == 1;
+        return {@args};
+    }
+
+    package Bar;
+    use Moose;
+
+    extends qw(Foo);
+}
+
+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" );
+    {
+        my $o = $class->new(bar => 42, baz => 47);
+        is($o->bar, 42, '... got the right bar');
+        is($o->baz, 47, '... got the right bar');
+    }
+    {
+        my $o = $class->new(42, baz => 47);
+        is($o->bar, 42, '... got the right bar');
+        is($o->baz, 47, '... got the right bar');
+    }    
+}
+
+
diff --git a/t/100_bugs/016_inheriting_from_roles.t b/t/100_bugs/016_inheriting_from_roles.t
new file mode 100644
index 0000000..4d423be
--- /dev/null
+++ b/t/100_bugs/016_inheriting_from_roles.t
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');
+}
+
+{
+    package My::Role;
+    use Moose::Role;
+}
+{
+    package My::Class;
+    use Moose;
+    
+    ::throws_ok {
+        extends 'My::Role';
+    } qr/You cannot inherit from a Moose Role \(My\:\:Role\)/, 
+    '... this croaks correctly';
+}
diff --git a/t/300_immutable/009_buildargs.t b/t/300_immutable/009_buildargs.t
index e1a3016..6c1ca33 100644
--- a/t/300_immutable/009_buildargs.t
+++ b/t/300_immutable/009_buildargs.t
@@ -3,13 +3,14 @@
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::More tests => 14;
 
 {
     package Foo;
     use Moose;
 
     has bar => ( is => "rw" );
+    has baz => ( is => "rw" );    
 
     sub BUILDARGS {
         my ( $self, @args ) = @_;
@@ -17,11 +18,13 @@ use Test::More 'no_plan';
         return {@args};
     }
 
+    __PACKAGE__->meta->make_immutable;
+
     package Bar;
     use Moose;
 
     extends qw(Foo);
-
+    
     __PACKAGE__->meta->make_immutable;
 }
 
@@ -29,4 +32,16 @@ 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" );
+    {
+        my $o = $class->new(bar => 42, baz => 47);
+        is($o->bar, 42, '... got the right bar');
+        is($o->baz, 47, '... got the right bar');
+    }
+    {
+        my $o = $class->new(42, baz => 47);
+        is($o->bar, 42, '... got the right bar');
+        is($o->baz, 47, '... got the right bar');
+    }    
 }
+
+