From: Stevan Little Date: Wed, 19 Apr 2006 18:45:10 +0000 (+0000) Subject: more-tests X-Git-Tag: 0_05~19 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bbd2fe69ecc397f2a29ca05a49638684aa3ccc91;p=gitmo%2FMoose.git more-tests --- diff --git a/t/010_basic_class_setup.t b/t/010_basic_class_setup.t index 6eda123..7647693 100644 --- 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 --- 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 --- 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 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 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 --- 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');