more-tests

diff --git a/t/010_basic_class_setup.t b/t/010_basic_class_setup.t
index 6eda123..7647693 100644 (file)
--- a/t/010_basic_class_setup.t
+++ b/t/010_basic_class_setup.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 21;
+use Test::More tests => 23;
 use Test::Exception;
 
 BEGIN {
@@ -22,6 +22,14 @@ isa_ok(Foo->meta, 'Moose::Meta::Class');
 ok(Foo->meta->has_method('meta'), '... we got the &meta method');
 ok(Foo->isa('Moose::Object'), '... Foo is automagically a Moose::Object');
 
+dies_ok {
+   Foo->meta->has_method() 
+} '... has_method requires an arg';
+
+dies_ok {
+   Foo->meta->has_method('') 
+} '... has_method requires an arg';
+
 can_ok('Foo', 'does');
 
 foreach my $function (qw(

diff --git a/t/021_moose_w_metaclass.t b/t/021_moose_w_metaclass.t
index f71258f..3bfabd1 100644 (file)
--- a/t/021_moose_w_metaclass.t
+++ b/t/021_moose_w_metaclass.t
@@ -10,6 +10,18 @@ BEGIN {
     use_ok('Moose');           
 }
 
+=pod
+
+This test demonstrates that Moose will respect 
+a metaclass previously set with the metaclass 
+pragma. 
+
+It also checks an error condition where that 
+metaclass must be a Moose::Meta::Class subclass
+in order to work.
+
+=cut
+
 
 {
     package Foo::Meta;

diff --git a/t/022_moose_respects_base.t b/t/022_moose_respects_base.t
index 5c96175..9366b9e 100644 (file)
--- a/t/022_moose_respects_base.t
+++ b/t/022_moose_respects_base.t
@@ -3,13 +3,24 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 7;
 use Test::Exception;
 
 BEGIN {
     use_ok('Moose');           
 }
 
+=pod
+
+This test demonstrates that Moose will respect 
+a previously set @ISA using use base, and not 
+try to add Moose::Object to it. 
+
+However, this is extremely order sensitive as 
+this test also demonstrates.
+
+=cut
+
 {
     package Foo;
     use strict;
@@ -20,11 +31,27 @@ BEGIN {
     package Bar;
     use strict;
     use warnings;
-    use Moose;
     
     use base 'Foo';
+    
+    use Moose;
+    
+    sub new { (shift)->meta->new_object(@_) }    
+    
+    package Baz;
+    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
+isa_ok($bar, 'Foo');
+ok(!$bar->isa('Moose::Object'), '... Bar is not Moose::Object subclass');
+
+my $baz = Baz->new;
+isa_ok($baz, 'Baz');
+isa_ok($baz, 'Foo');
+isa_ok($baz, 'Moose::Object');
+

diff --git a/t/023_moose_respects_type_constraints.t b/t/023_moose_respects_type_constraints.t
new file mode 100644 (file)
index 0000000..24ecd1c
--- /dev/null
+++ b/t/023_moose_respects_type_constraints.t
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');           
+    use_ok('Moose::Util::TypeConstraints');               
+}
+
+=pod
+
+This tests demonstrates that Moose will not override 
+a pre-existing type constraint of the same name when 
+making constraints for a Moose-class.
+
+It also tests that an attribute which uses a 'Foo' for
+it's isa option will get the subtype Foo, and not a 
+type representing the Foo moose class.
+
+=cut
+
+BEGIN { 
+    # create this subtype first (in BEGIN)
+    subtype Foo 
+        => as 'Value' 
+        => where { $_ eq 'Foo' };
+}
+
+{ # now seee if Moose will override it
+    package Foo;
+    use strict;
+    use warnings;
+    use Moose;
+}
+
+my $foo_constraint = find_type_constraint('Foo');
+isa_ok($foo_constraint, 'Moose::Meta::TypeConstraint');
+
+is($foo_constraint->parent->name, 'Value', '... got the Value subtype for Foo');
+
+ok($foo_constraint->check('Foo'), '... my constraint passed correctly');
+ok(!$foo_constraint->check('Bar'), '... my constraint failed correctly');
+
+{
+    package Bar;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    has 'foo' => (is => 'rw', isa => 'Foo');
+}
+
+my $bar = Bar->new;
+isa_ok($bar, 'Bar');
+
+lives_ok {
+    $bar->foo('Foo');       
+} '... checked the type constraint correctly';
+
+dies_ok {
+    $bar->foo(Foo->new);       
+} '... checked the type constraint correctly';
+
+
+

diff --git a/t/035_attribute_required.t b/t/035_attribute_required.t
new file mode 100644 (file)
index 0000000..622ae0c
--- /dev/null
+++ b/t/035_attribute_required.t
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 14;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');           
+}
+
+{
+    package Foo;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    has 'bar' => (is => 'ro', required => 1);
+    has 'baz' => (is => 'rw', default => 100, required => 1); 
+
+    # NOTE:
+    # this attribute is actually kind of silly  
+    # since lazy requires default, then the 
+    # required attribute becomes void in this 
+    # case. But hey, best to test it :)
+    has 'boo' => (is => 'rw', lazy => 1, default => 50, required => 1);       
+}
+
+{
+    my $foo = Foo->new(bar => 10, baz => 20, boo => 100);
+    isa_ok($foo, 'Foo');
+    
+    is($foo->bar, 10, '... got the right bar');
+    is($foo->baz, 20, '... got the right baz');    
+    is($foo->boo, 100, '... got the right boo');        
+}
+
+{
+    my $foo = Foo->new(bar => 10, boo => 5);
+    isa_ok($foo, 'Foo');
+    
+    is($foo->bar, 10, '... got the right bar');
+    is($foo->baz, 100, '... got the right baz');    
+    is($foo->boo, 5, '... got the right boo');            
+}
+
+{
+    my $foo = Foo->new(bar => 10);
+    isa_ok($foo, 'Foo');
+    
+    is($foo->bar, 10, '... got the right bar');
+    is($foo->baz, 100, '... got the right baz');    
+    is($foo->boo, 50, '... got the right boo');            
+}
+
+throws_ok {
+    Foo->new;
+} qr/^Attribute \(bar\) is required/, '... must supply all the required attribute';
+

diff --git a/t/042_apply_role.t b/t/042_apply_role.t
index e9f819b..469b1dd 100644 (file)
--- a/t/042_apply_role.t
+++ b/t/042_apply_role.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 36;
+use Test::More tests => 39;
 use Test::Exception;
 
 BEGIN {  
@@ -53,6 +53,18 @@ BEGIN {
 my $foo_class_meta = FooClass->meta;
 isa_ok($foo_class_meta, 'Moose::Meta::Class');
 
+dies_ok {
+    $foo_class_meta->does_role()
+} '... does_role requires a role name';
+
+dies_ok {
+    $foo_class_meta->apply_role()
+} '... apply_role requires a role';
+
+dies_ok {
+    $foo_class_meta->apply_role(bless({} => 'Fail'))
+} '... apply_role requires a role';
+
 ok($foo_class_meta->does_role('FooRole'), '... the FooClass->meta does_role FooRole');
 ok(!$foo_class_meta->does_role('OtherRole'), '... the FooClass->meta !does_role OtherRole');