X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F05-pod-examples.t;h=5aa6fc55eb9893f18ed3028f2840a4acbc69ae81;hb=52ed7d4d952fd6eaf67bb394eabe215cd2eaf746;hp=e16a7b08fa4f7851d4fcec9fa0202bebfc0b84b3;hpb=910bb5389be9e75022a3bba041dfe75db4ccc4b4;p=gitmo%2FMooseX-Dependent.git diff --git a/t/05-pod-examples.t b/t/05-pod-examples.t index e16a7b0..5aa6fc5 100644 --- a/t/05-pod-examples.t +++ b/t/05-pod-examples.t @@ -199,95 +199,45 @@ use Test::More; ## See t/02-types-parameterizable-extended.t for remaining examples tests } +{ + package Test::MooseX::Types::Parameterizable::Coercions; -done_testing; - - -__END__ - -use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet PositiveUniqueInt )]; - -subtype Set, - as class_type("Set::Scalar"); - -subtype UniqueInt, - as Parameterizable[Int, Set], - where { - my ($int, $set) = @_; - !$set->has($int); - }; - -subtype PositiveSet, - as Set, - where { - my ($set) = @_; - ! grep { $_ < 0 } $set->members; - }; - -subtype PositiveUniqueInt, - as UniqueInt[PositiveSet]; - -my $set = Set::Scalar->new(-1,-2,1,2,3); -my $positive_set = Set::Scalar->new(1,2,3); -my $negative_set = Set::Scalar->new(-1,-2,-3); - -ok Set->check($set), - 'Is a Set'; - -ok Set->check($positive_set), - 'Is a Set'; - -ok Set->check($negative_set), - 'Is a Set'; - -ok !PositiveSet->check($set), - 'Is Not a Positive Set'; - -ok PositiveSet->check($positive_set), - 'Is a Positive Set'; - -ok !PositiveSet->check($negative_set), - 'Is Not a Positive Set'; - -ok UniqueInt([$set])->check(100), - '100 not in Set'; - -ok UniqueInt([$positive_set])->check(100), - '100 not in Set'; - -ok UniqueInt([$negative_set])->check(100), - '100 not in Set'; - -ok UniqueInt([$set])->check(-99), - '-99 not in Set'; - -ok UniqueInt([$positive_set])->check(-99), - '-99 not in Set'; + use Moose; + use MooseX::Types::Parameterizable qw(Parameterizable); + use MooseX::Types::Moose qw(HashRef ArrayRef Object Str Int); + use MooseX::Types -declare=>[qw(Varchar MySpecialVarchar )]; -ok UniqueInt([$negative_set])->check(-99), - '-99 not in Set'; -ok !UniqueInt([$set])->check(2), - '2 in Set'; + subtype Varchar, + as Parameterizable[Str, Int], + where { + my($string, $int) = @_; + $int >= length($string) ? 1:0; + }, + message { "'$_' is too long" }; -ok !UniqueInt([$positive_set])->check(2), - '2 in Set'; -ok UniqueInt([$negative_set])->check(2), - '2 not in Set'; + coerce Varchar, + from Object, + via { "$_"; }, ## stringify the object + from ArrayRef, + via { join '',@$_ }; ## convert array to string + subtype MySpecialVarchar, + as Varchar; -__END__ + coerce MySpecialVarchar, + from HashRef, + via { join '', keys %$_ }; -ok UniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) -ok UniqueInt([$set])->check(-99); ## Okay, -99 isn't in (1,2,3) -ok !UniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) -ok PositiveUniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) -ok !PositiveUniqueInt([$set])->check(-99); ## Not OK, -99 not Positive Int -ok !PositiveUniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) + Test::More::is Varchar([40])->coerce("abc"), 'abc'; + Test::More::is Varchar([40])->coerce([qw/d e f/]), 'def'; -my $negative_set = Set::Scalar->new(-1,-2,-3); + Test::More::is MySpecialVarchar([40])->coerce("abc"), 'abc'; + Test::More::is_deeply( MySpecialVarchar([40])->coerce([qw/d e f/]), [qw/d e f/]); + Test::More::is MySpecialVarchar([40])->coerce({a=>1, b=>2}), 'ab'; +} -ok UniqueInt([$negative_set])->check(100); ## Throws exception +done_testing;