use Test::More;
-eval "use Set::Scalar"; if($@) {
- plan skip_all => 'Set::Scalar not installed';
-}
-
-
{
package Test::MooseX::Types::Parameterizable::Synopsis;
use Moose;
use MooseX::Types::Parameterizable qw(Parameterizable);
- use MooseX::Types::Moose qw(Str Int);
+ use MooseX::Types::Moose qw(Str Int ArrayRef);
use MooseX::Types -declare=>[qw(Varchar)];
subtype Varchar,
},
message { "'$_' is too long" };
+ coerce Varchar,
+ from ArrayRef,
+ via {
+ my ($arrayref, $int) = @_;
+ join('', @$arrayref);
+ };
+
my $varchar_five = Varchar[5];
Test::More::ok $varchar_five->check('four');
Test::More::ok $varchar_ten->check( 'X' x 9 );
Test::More::ok ! $varchar_ten->check( 'X' x 12 );
- has varchar_five => (isa=>Varchar[5], is=>'ro');
+ has varchar_five => (isa=>Varchar[5], is=>'ro', coerce=>1);
has varchar_ten => (isa=>Varchar[10], is=>'ro');
my $object1 = __PACKAGE__->new(
Test::More::ok $@, 'There was an error';
Test::More::like $@, qr('12345678' is too long), 'Correct custom error';
+
+ my $object3 = __PACKAGE__->new(
+ varchar_five => [qw/aa bb/],
+ varchar_ten => '123456789',
+ );
+
+ Test::More::is $object3->varchar_five, 'aabb',
+ 'coercion as expected';
}
-done_testing;
+{
+ package Test::MooseX::Types::Parameterizable::Description;
+ use Moose;
+ use MooseX::Types::Parameterizable qw(Parameterizable);
+ use MooseX::Types::Moose qw(HashRef Int);
+ use MooseX::Types -declare=>[qw(Range RangedInt)];
+
+ ## Minor change from docs to avoid additional test dependencies
+ subtype Range,
+ as HashRef[Int],
+ where {
+ my ($range) = @_;
+ return $range->{max} > $range->{min};
+ },
+ message { "Not a Valid range [ $_->{max} not > $_->{min} ] " };
+
+ subtype RangedInt,
+ as Parameterizable[Int, Range],
+ where {
+ my ($value, $range) = @_;
+ return ($value >= $range->{min} &&
+ $value <= $range->{max});
+ };
+
+ Test::More::ok RangedInt([{min=>10,max=>100}])->check(50);
+ Test::More::ok !RangedInt([{min=>50, max=>75}])->check(99);
-__END__
+ eval {
+ Test::More::ok !RangedInt([{min=>99, max=>10}])->check(10);
+ };
-use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet PositiveUniqueInt )];
+ Test::More::ok $@, 'There was an error';
+ Test::More::like $@, qr(Not a Valid range), 'Correct custom error';
-subtype Set,
- as class_type("Set::Scalar");
+ Test::More::ok RangedInt([min=>10,max=>100])->check(50);
+ Test::More::ok ! RangedInt([min=>50, max=>75])->check(99);
-subtype UniqueInt,
- as Parameterizable[Int, Set],
- where {
- my ($int, $set) = @_;
- !$set->has($int);
- };
+ eval {
+ RangedInt([min=>99, max=>10])->check(10);
+ };
-subtype PositiveSet,
- as Set,
- where {
- my ($set) = @_;
- ! grep { $_ < 0 } $set->members;
- };
-
-subtype PositiveUniqueInt,
- as UniqueInt[PositiveSet];
+ Test::More::ok $@, 'There was an error';
+ Test::More::like $@, qr(Not a Valid range), 'Correct custom error';
+
+
+}
+
+{
+ package Test::MooseX::Types::Parameterizable::Subtypes;
+
+ use Moose;
+ use MooseX::Types::Parameterizable qw(Parameterizable);
+ use MooseX::Types::Moose qw(HashRef Int);
+ use MooseX::Types -declare=>[qw(Range RangedInt PositiveRangedInt
+ PositiveInt PositiveRange PositiveRangedInt2 )];
+
+ ## Minor change from docs to avoid additional test dependencies
+ subtype Range,
+ as HashRef[Int],
+ where {
+ my ($range) = @_;
+ return $range->{max} > $range->{min};
+ },
+ message { "Not a Valid range [ $_->{max} not > $_->{min} ] " };
+
+ subtype RangedInt,
+ as Parameterizable[Int, Range],
+ where {
+ my ($value, $range) = @_;
+ return ($value >= $range->{min} &&
+ $value <= $range->{max});
+ };
+
+ subtype PositiveRangedInt,
+ as RangedInt,
+ where {
+ shift >= 0;
+ };
+
+ Test::More::ok PositiveRangedInt([{min=>10,max=>100}])->check(50);
+ Test::More::ok !PositiveRangedInt([{min=>50, max=>75}])->check(99);
+
+ eval {
+ Test::More::ok !PositiveRangedInt([{min=>99, max=>10}])->check(10);
+ };
-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);
+ Test::More::ok $@, 'There was an error';
+ Test::More::like $@, qr(Not a Valid range), 'Correct custom error';
-ok Set->check($set),
- 'Is a Set';
+ Test::More::ok PositiveRangedInt([min=>10,max=>100])->check(50);
+ Test::More::ok ! PositiveRangedInt([min=>50, max=>75])->check(99);
-ok Set->check($positive_set),
- 'Is a Set';
+ eval {
+ PositiveRangedInt([min=>99, max=>10])->check(10);
+ };
-ok Set->check($negative_set),
- 'Is a Set';
+ Test::More::ok $@, 'There was an error';
+ Test::More::like $@, qr(Not a Valid range), 'Correct custom error';
-ok !PositiveSet->check($set),
- 'Is Not a Positive Set';
+ Test::More::ok !PositiveRangedInt([{min=>-10, max=>75}])->check(-5);
-ok PositiveSet->check($positive_set),
- 'Is a Positive Set';
+ ## Subtype of Int for positive numbers
+ subtype PositiveInt,
+ as Int,
+ where {
+ my ($value, $range) = @_;
+ return $value >= 0;
+ };
-ok !PositiveSet->check($negative_set),
- 'Is Not a Positive Set';
+ ## subtype Range to re-parameterize Range with subtypes. Minor change from
+ ## docs to reduce test dependencies
-ok UniqueInt([$set])->check(100),
- '100 not in Set';
+ subtype PositiveRange,
+ as Range[PositiveInt],
+ message { "[ $_->{max} not > $_->{min} ] is not a positive range " };
+
+ ## create subtype via reparameterizing
+ subtype PositiveRangedInt2,
+ as RangedInt[PositiveRange];
-ok UniqueInt([$positive_set])->check(100),
- '100 not in Set';
+ Test::More::ok PositiveRangedInt2([{min=>10,max=>100}])->check(50);
+ Test::More::ok !PositiveRangedInt2([{min=>50, max=>75}])->check(99);
-ok UniqueInt([$negative_set])->check(100),
- '100 not in Set';
+ eval {
+ Test::More::ok !PositiveRangedInt2([{min=>99, max=>10}])->check(10);
+ };
-ok UniqueInt([$set])->check(-99),
- '-99 not in Set';
+ Test::More::ok $@, 'There was an error';
+ Test::More::like $@, qr(not a positive range), 'Correct custom error';
-ok UniqueInt([$positive_set])->check(-99),
- '-99 not in Set';
+ Test::More::ok !PositiveRangedInt2([{min=>10, max=>75}])->check(-5);
-ok UniqueInt([$negative_set])->check(-99),
- '-99 not in Set';
+ ## See t/02-types-parameterizable-extended.t for remaining examples tests
+}
-ok !UniqueInt([$set])->check(2),
- '2 in Set';
+{
+ package Test::MooseX::Types::Parameterizable::Coercions;
-ok !UniqueInt([$positive_set])->check(2),
- '2 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(2),
- '2 not in Set';
+ subtype Varchar,
+ as Parameterizable[Str, Int],
+ where {
+ my($string, $int) = @_;
+ $int >= length($string) ? 1:0;
+ },
+ message { "'$_' is too long" };
+
+
+ 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';
+}
+
+{
+ package Test::MooseX::Types::Parameterizable::Recursion;
-ok UniqueInt([$negative_set])->check(100); ## Throws exception
+ use Moose;
+ use MooseX::Types::Parameterizable qw(Parameterizable);
+ use MooseX::Types::Moose qw( );
+ use MooseX::Types -declare=>[qw( )];
+
+ ## To be done when I can think of a use case
+}
+
+done_testing;