From: John Napiorkowski Date: Tue, 7 Oct 2008 14:18:38 +0000 (+0000) Subject: added missing file from the last checkin (oops) X-Git-Tag: 0.01~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types-Structured.git;a=commitdiff_plain;h=896f108d1236179ab9a8c874c4b2cf92b844aa53 added missing file from the last checkin (oops) --- diff --git a/t/05-advanced.t b/t/05-advanced.t new file mode 100644 index 0000000..ea1e302 --- /dev/null +++ b/t/05-advanced.t @@ -0,0 +1,112 @@ +BEGIN { + use strict; + use warnings; + use Test::More tests=>12; + use Test::Exception; +} + +{ + package Test::MooseX::Meta::TypeConstraint::Structured::Advanced; + + 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( + 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, + where { $#{$_->[0]} >= 4}; + + ## Complexe Dict + subtype PersonalInfo, + as Dict[name=>Str, stats=>MoreLengthPlease|Object]; + + ## Minimum 5 char string + subtype MinFiveChars, + as Str, + where { length($_) > 5}; + + ## Dict key overloading + subtype MorePersonalInfo, + as PersonalInfo[name=>MinFiveChars]; + + has 'EqualLengthAttr' => (is=>'rw', isa=>EqualLength); + has 'MoreLengthPleaseAttr' => (is=>'rw', isa=>MoreLengthPlease); + has 'PersonalInfoAttr' => (is=>'rw', isa=>PersonalInfo); + has 'MorePersonalInfo' => (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 { + $obj->EqualLengthAttr([[6,7,8],[9,10,11]]); +} => 'Set EqualLengthAttr attribute without error'; + +throws_ok sub { + $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]]); +}, 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]]); +}, qr/Attribute \(EqualLengthAttr\) does not pass the type constraint/ + => q{EqualLengthAttr correctly fails [[6,7,1],[9,10,11]]}; + +## Test MoreLengthPleaseAttr + +lives_ok sub { + $obj->MoreLengthPleaseAttr([[6,7,8,9,10],[11,12,13,14,15]]); +} => 'Set MoreLengthPleaseAttr attribute without error'; + +throws_ok sub { + $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]]}; + +## Test PersonalInfoAttr + +lives_ok sub { + $obj->PersonalInfoAttr({name=>'John', stats=>[[6,7,8,9,10],[11,12,13,14,15]]}); +} => 'Set MoreLengthPleaseAttr attribute without error 1'; + +lives_ok sub { + $obj->PersonalInfoAttr({name=>'John', stats=>$obj}); +} => 'Set MoreLengthPleaseAttr attribute without error 2'; + +throws_ok sub { + $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]]}; + +throws_ok sub { + $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]]}; + +