X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F05-pod-examples.t;h=936b31b22adc2fea987f535f88073eea15df4eca;hb=7fcab9b40542736383582f82fb2103e527963f4c;hp=061dcec47761a2515d53d64385cae7855168cb82;hpb=1fa2711689a9544c68dd3a718135fcc53c43a163;p=gitmo%2FMooseX-Dependent.git

diff --git a/t/05-pod-examples.t b/t/05-pod-examples.t
index 061dcec..936b31b 100644
--- a/t/05-pod-examples.t
+++ b/t/05-pod-examples.t
@@ -3,17 +3,12 @@ use warnings;
 
 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,
@@ -24,6 +19,13 @@ eval "use Set::Scalar"; if($@) {
       },
       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');
@@ -34,7 +36,7 @@ eval "use Set::Scalar"; if($@) {
     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(
@@ -51,96 +53,202 @@ eval "use Set::Scalar"; if($@) {
 
     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;