more docs, test fixes and prep for release
[gitmo/MooseX-Dependent.git] / t / 05-pod-examples.t
index 061dcec..1810599 100644 (file)
@@ -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,8 +53,65 @@ 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';
+}
+
+{
+    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);
+
+    eval {
+        Test::More::ok !RangedInt([{min=>99, max=>10}])->check(10); 
+    }; 
+
+    Test::More::ok $@, 'There was an error';
+    Test::More::like $@, qr(Not a Valid range), 'Correct custom error';
+
+    Test::More::ok RangedInt([min=>10,max=>100])->check(50);
+    Test::More::ok ! RangedInt([min=>50, max=>75])->check(99);
+
+    eval {
+        RangedInt([min=>99, max=>10])->check(10); 
+    }; 
+
+    Test::More::ok $@, 'There was an error';
+    Test::More::like $@, qr(Not a Valid range), 'Correct custom error';
+
+
 }
 
+
 done_testing;