X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F05-advanced.t;h=3d2832232ddf6ee756b81f8cd9d682e616681e33;hb=25c705c4f401f9a52eba667e8c72720ace257be6;hp=76cd1341fb08a2f6d4635ddad06c66b06ec2f9bc;hpb=a4a88fefad0246cc6b5eea44874bcfb2ff34253d;p=gitmo%2FMooseX-Types-Structured.git diff --git a/t/05-advanced.t b/t/05-advanced.t index 76cd134..3d28322 100644 --- a/t/05-advanced.t +++ b/t/05-advanced.t @@ -1,8 +1,8 @@ BEGIN { - use strict; - use warnings; - use Test::More tests=>16; - use Test::Exception; + use strict; + use warnings; + use Test::More tests=>16; + use Test::Fatal; } { @@ -10,21 +10,21 @@ BEGIN { use Moose; use MooseX::Types::Structured qw(Dict Tuple); - use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe); - use MooseX::Types -declare => [qw( + use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe); + use MooseX::Types -declare => [qw( EqualLength MoreThanFive MoreLengthPlease PersonalInfo MorePersonalInfo MinFiveChars )]; - + subtype MoreThanFive, as Int, where { $_ > 5}; - + ## Tuple contains two equal length Arrays subtype EqualLength, as Tuple[ArrayRef[MoreThanFive],ArrayRef[MoreThanFive]], where { $#{$_->[0]} == $#{$_->[1]} }; - + ## subclass the complex tuple subtype MoreLengthPlease, as EqualLength, @@ -33,101 +33,101 @@ BEGIN { ## Complexe Dict subtype PersonalInfo, as Dict[name=>Str, stats=>MoreLengthPlease|Object]; - + ## Minimum 5 char string subtype MinFiveChars, as Str, - where { length($_) > 5}; - + where { length($_) > 5}; + ## Dict key overloading subtype MorePersonalInfo, as PersonalInfo[name=>MinFiveChars, stats=>MoreLengthPlease|Object]; - + has 'EqualLengthAttr' => (is=>'rw', isa=>EqualLength); has 'MoreLengthPleaseAttr' => (is=>'rw', isa=>MoreLengthPlease); has 'PersonalInfoAttr' => (is=>'rw', isa=>PersonalInfo); - has 'MorePersonalInfo' => (is=>'rw', isa=>MorePersonalInfo); + has 'MorePersonalInfoAttr' => (is=>'rw', isa=>MorePersonalInfo); } ## Instantiate a new test object ok my $obj = Test::MooseX::Meta::TypeConstraint::Structured::Advanced->new => 'Instantiated new Record test class.'; - + isa_ok $obj => 'Test::MooseX::Meta::TypeConstraint::Structured::Advanced' => 'Created correct object type.'; - + ## Test EqualLengthAttr -lives_ok sub { +is( exception { $obj->EqualLengthAttr([[6,7,8],[9,10,11]]); -} => 'Set EqualLengthAttr attribute without error'; +} => undef, 'Set EqualLengthAttr attribute without error'); -throws_ok sub { - $obj->EqualLengthAttr([1,'hello', 'test.xxx.test']); +like( exception { + $obj->EqualLengthAttr([1,'hello', 'test.xxx.test']); }, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/ - => q{EqualLengthAttr correctly fails [1,'hello', 'test.xxx.test']}; - -throws_ok sub { - $obj->EqualLengthAttr([[6,7],[9,10,11]]); + => q{EqualLengthAttr correctly fails [1,'hello', 'test.xxx.test']}); + +like( exception { + $obj->EqualLengthAttr([[6,7],[9,10,11]]); }, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/ - => q{EqualLengthAttr correctly fails [[6,7],[9,10,11]]}; - -throws_ok sub { - $obj->EqualLengthAttr([[6,7,1],[9,10,11]]); + => q{EqualLengthAttr correctly fails [[6,7],[9,10,11]]}); + +like( exception { + $obj->EqualLengthAttr([[6,7,1],[9,10,11]]); }, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/ - => q{EqualLengthAttr correctly fails [[6,7,1],[9,10,11]]}; - + => q{EqualLengthAttr correctly fails [[6,7,1],[9,10,11]]}); + ## Test MoreLengthPleaseAttr -lives_ok sub { +is( exception { $obj->MoreLengthPleaseAttr([[6,7,8,9,10],[11,12,13,14,15]]); -} => 'Set MoreLengthPleaseAttr attribute without error'; +} => undef, 'Set MoreLengthPleaseAttr attribute without error'); -throws_ok sub { - $obj->MoreLengthPleaseAttr([[6,7,8,9],[11,12,13,14]]); +like( exception { + $obj->MoreLengthPleaseAttr([[6,7,8,9],[11,12,13,14]]); }, qr/Attribute \(MoreLengthPleaseAttr\) does not pass the type constraint/ - => q{MoreLengthPleaseAttr correctly fails [[6,7,8,9],[11,12,13,14]]}; - + => q{MoreLengthPleaseAttr correctly fails [[6,7,8,9],[11,12,13,14]]}); + ## Test PersonalInfoAttr -lives_ok sub { +is( exception { $obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); -} => 'Set PersonalInfoAttr attribute without error 1'; +} => undef, 'Set PersonalInfoAttr attribute without error 1'); -lives_ok sub { +is( exception { $obj->PersonalInfoAttr({name=>'John', stats=>$obj}); -} => 'Set PersonalInfoAttr attribute without error 2'; +} => undef, 'Set PersonalInfoAttr attribute without error 2'); -throws_ok sub { - $obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]}); +like( exception { + $obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]}); }, qr/Attribute \(PersonalInfoAttr\) does not pass the type constraint/ - => q{PersonalInfoAttr correctly fails name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]}; + => q{PersonalInfoAttr correctly fails name=>'John', stats=>[[6,7,8,9],[11,12,13,14]]}); -throws_ok sub { - $obj->PersonalInfoAttr({name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); +like( exception { + $obj->PersonalInfoAttr({name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); }, qr/Attribute \(PersonalInfoAttr\) does not pass the type constraint/ - => q{PersonalInfoAttr correctly fails name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}; + => q{PersonalInfoAttr correctly fails name=>'John', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); -## Test MorePersonalInfo +## Test MorePersonalInfoAttr -lives_ok sub { - $obj->MorePersonalInfo({name=>'Johnnap', stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); -} => 'Set MorePersonalInfo attribute without error 1'; +is( exception { + $obj->MorePersonalInfoAttr({name=>'Johnnap', stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); +} => undef, 'Set MorePersonalInfoAttr attribute without error 1'); -throws_ok sub { - $obj->MorePersonalInfo({name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]}); -}, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/ - => q{MorePersonalInfo correctly fails name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]}; +like( exception { + $obj->MorePersonalInfoAttr({name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]}); +}, qr/Attribute \(MorePersonalInfoAttr\) does not pass the type constraint/ + => q{MorePersonalInfoAttr correctly fails name=>'Johnnap', stats=>[[6,7,8,9],[11,12,13,14]]}); -throws_ok sub { - $obj->MorePersonalInfo({name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); -}, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/ - => q{MorePersonalInfo correctly fails name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}; +like( exception { + $obj->MorePersonalInfoAttr({name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); +}, qr/Attribute \(MorePersonalInfoAttr\) does not pass the type constraint/ + => q{MorePersonalInfoAttr correctly fails name=>'Johnnap', extra=>1, stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); -throws_ok sub { - $obj->MorePersonalInfo({name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); -}, qr/Attribute \(MorePersonalInfo\) does not pass the type constraint/ - => q{MorePersonalInfo correctly fails name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]}; +like( exception { + $obj->MorePersonalInfoAttr({name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); +}, qr/Attribute \(MorePersonalInfoAttr\) does not pass the type constraint/ + => q{MorePersonalInfoAttr correctly fails name=>'.bc', stats=>[[6,7,8,9,10],[11,12,13,14,15]]});