tests

diff --git a/Changes b/Changes
index 8da8df4..9f02222 100644 (file)
--- a/Changes
+++ b/Changes
@@ -12,6 +12,8 @@ Revision history for Perl extension Moose
       - added Bool type and CollectionRef type
         then made ArrayRef and HashRef into subtypes 
         of the CollectionRef
+      - keywords are now exported with Sub::Exporter
+        thanks chansen for this commit
 
 0.04 Sun. April 16th, 2006
     * Moose::Role

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 4ceab19..d0b1086 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -37,7 +37,7 @@ sub new {
                }
                elsif ($options{is} eq 'rw') {
                        $options{accessor} = $name;                             
-                       (reftype($options{trigger}) eq 'CODE')
+                       ((reftype($options{trigger}) || '') eq 'CODE')
                            || confess "A trigger must be a CODE reference"
                                if exists $options{trigger};                    
                }                       
@@ -50,6 +50,9 @@ sub new {
                    ($options{isa}->does($options{does}))                   
                        || confess "Cannot have an isa option and a does option if the isa does not do the does";
                }
+               else {
+                   confess "Cannot have an isa option which cannot ->does()";
+               }
            }       
            
            # allow for anon-subtypes here ...

diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index 5299a79..9671f3a 100644 (file)
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -13,27 +13,34 @@ use Sub::Exporter;
 our $VERSION = '0.03';
 
 use Moose::Meta::Role;
+use Moose::Util::TypeConstraints;
 
 {
     my ( $CALLER, %METAS );
 
     sub _find_meta {
-        my $class = $CALLER;
+        my $role = $CALLER;
 
-        return $METAS{$class} if exists $METAS{$class};
+        return $METAS{$role} if exists $METAS{$role};
+        
+        # make a subtype for each Moose class
+        subtype $role
+            => as 'Role'
+            => where { $_->does($role) }
+        unless find_type_constraint($role);        
 
        my $meta;
-       if ($class->can('meta')) {
-               $meta = $class->meta();
+       if ($role->can('meta')) {
+               $meta = $role->meta();
                (blessed($meta) && $meta->isa('Moose::Meta::Role'))
                        || confess "Whoops, not møøsey enough";
        }
        else {
-               $meta = Moose::Meta::Role->new(role_name => $class);
+               $meta = Moose::Meta::Role->new(role_name => $role);
                $meta->_role_meta->add_method('meta' => sub { $meta })          
        }
 
-        return $METAS{$class} = $meta;
+        return $METAS{$role} = $meta;
     }
  
        

diff --git a/t/011_require_superclasses.t b/t/011_require_superclasses.t
index beacd42..3925cf4 100644 (file)
--- a/t/011_require_superclasses.t
+++ b/t/011_require_superclasses.t
@@ -5,7 +5,7 @@ use warnings;
 
 use lib 't/lib', 'lib';
 
-use Test::More tests => 4;
+use Test::More tests => 6;
 
 BEGIN {
     use_ok('Moose');           
@@ -41,3 +41,14 @@ BEGIN {
     ::ok(!$@, '... loaded Foo and (inline) Bar superclass correctly');
 }
 
+{
+    package Bling;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    eval { extends 'No::Class'; };
+    ::ok($@, '... could not find the superclass (as expected)');
+    ::like($@, qr/^Could not load superclass 'No\:\:Class' because \:/, '... and got the error we expected');
+}
+

diff --git a/t/021_moose_w_metaclass.t b/t/021_moose_w_metaclass.t
new file mode 100644 (file)
index 0000000..f71258f
--- /dev/null
+++ b/t/021_moose_w_metaclass.t
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');           
+}
+
+
+{
+    package Foo::Meta;
+    use strict;
+    use warnings;
+
+    use base 'Moose::Meta::Class';
+    
+    package Foo;
+    use strict;
+    use warnings;
+    use metaclass 'Foo::Meta';
+    ::use_ok('Moose');
+}
+
+isa_ok(Foo->meta, 'Foo::Meta');
+
+{
+    package Bar::Meta;
+    use strict;
+    use warnings;
+    
+    use base 'Class::MOP::Class';
+    
+    package Bar;
+    use strict;
+    use warnings;
+    use metaclass 'Bar::Meta';
+    eval 'use Moose;';
+    ::ok($@, '... could not load moose without correct metaclass');
+    ::like($@, qr/^Whoops\, not møøsey enough/, '... got the right error too');
+}

diff --git a/t/022_moose_respects_base.t b/t/022_moose_respects_base.t
new file mode 100644 (file)
index 0000000..5c96175
--- /dev/null
+++ b/t/022_moose_respects_base.t
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');           
+}
+
+{
+    package Foo;
+    use strict;
+    use warnings;
+    
+    sub foo { 'Foo::foo' }
+    
+    package Bar;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    use base 'Foo';
+}
+
+my $bar = Bar->new;
+isa_ok($bar, 'Bar');
+isa_ok($bar, 'Foo');
\ No newline at end of file

diff --git a/t/033_attribute_triggers.t b/t/033_attribute_triggers.t
index 66b0861..361bf4f 100644 (file)
--- a/t/033_attribute_triggers.t
+++ b/t/033_attribute_triggers.t
@@ -5,7 +5,7 @@ use warnings;
 
 use Scalar::Util 'isweak';
 
-use Test::More tests => 24;
+use Test::More tests => 27;
 use Test::Exception;
 
 BEGIN {
@@ -108,3 +108,32 @@ BEGIN {
     ok(isweak($baz->{foo}), '... baz.foo is a weak reference');
 }
 
+# some errors
+
+{
+    package Bling;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    ::dies_ok { 
+        has('bling' => (is => 'ro', trigger => sub { 0 }));
+    } '... cannot create trigger on a read-only attr';
+}
+
+{
+    package Bling::Bling;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    ::dies_ok { 
+        has('bling' => (is => 'rw', trigger => 'Fail'));
+    } '... a trigger must be a CODE ref';
+    
+    ::dies_ok { 
+        has('bling' => (is => 'rw', trigger => []));
+    } '... a trigger must be a CODE ref';    
+}
+
+

diff --git a/t/034_does_attribute_option.t b/t/034_attribute_does.t
similarity index 77%
rename from t/034_does_attribute_option.t
rename to t/034_attribute_does.t
index a154f93..f95360f 100644 (file)
--- a/t/034_does_attribute_option.t
+++ b/t/034_attribute_does.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 7;
+use Test::More tests => 8;
 use Test::Exception;
 
 BEGIN {
@@ -79,4 +79,25 @@ lives_ok {
         has 'foo' => (isa => 'Foo::Class', does => 'Bar::Class');
     } '... cannot have a does() which is not done by the isa()';
 }    
+
+{
+    package Bling;
+    use strict;
+    use warnings;
+    
+    sub bling { 'Bling::bling' }
+    
+    package Bling::Bling;
+    use strict;
+    use warnings;    
+    use Moose;
+
+    # if isa and does appear together, then see if Class->does(Role)
+    # if it does not,.. we have a conflict... so we die loudly
+    ::dies_ok {
+        has 'foo' => (isa => 'Bling', does => 'Bar::Class');
+    } '... cannot have a isa() which is cannot does()';
+}
+
+