t/05-pod-examples.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5
   6 {
   7     package Test::MooseX::Types::Parameterizable::Synopsis;
   8
   9     use Moose;
  10     use MooseX::Types::Parameterizable qw(Parameterizable);
  11     use MooseX::Types::Moose qw(Str Int ArrayRef);
  12     use MooseX::Types -declare=>[qw(Varchar)];
  13
  14     subtype Varchar,
  15       as Parameterizable[Str,Int],
  16       where {
  17         my($string, $int) = @_;
  18         $int >= length($string) ? 1:0;
  19       },
  20       message { "'$_' is too long"  };
  21
  22     coerce Varchar,
  23       from ArrayRef,
  24       via {
  25         my ($arrayref, $int) = @_;
  26         join('', @$arrayref);
  27       };
  28
  29     my $varchar_five = Varchar[5];
  30
  31     Test::More::ok $varchar_five->check('four');
  32     Test::More::ok ! $varchar_five->check('verylongstrong');
  33
  34     my $varchar_ten = Varchar[10];
  35
  36     Test::More::ok $varchar_ten->check( 'X' x 9 );
  37     Test::More::ok ! $varchar_ten->check( 'X' x 12 );
  38
  39     has varchar_five => (isa=>Varchar[5], is=>'ro', coerce=>1);
  40     has varchar_ten => (isa=>Varchar[10], is=>'ro');
  41
  42     my $object1 = __PACKAGE__->new(
  43         varchar_five => '1234',
  44         varchar_ten => '123456789',
  45     );
  46
  47     eval {
  48         my $object2 = __PACKAGE__->new(
  49             varchar_five => '12345678',
  50             varchar_ten => '123456789',
  51         );
  52     };
  53
  54     Test::More::ok $@, 'There was an error';
  55     Test::More::like $@, qr('12345678' is too long), 'Correct custom error';
  56
  57     my $object3 = __PACKAGE__->new(
  58         varchar_five => [qw/aa bb/],
  59         varchar_ten => '123456789',
  60     );
  61
  62     Test::More::is $object3->varchar_five, 'aabb',
  63       'coercion as expected';
  64 }
  65
  66 {
  67     package Test::MooseX::Types::Parameterizable::Description;
  68
  69     use Moose;
  70     use MooseX::Types::Parameterizable qw(Parameterizable);
  71     use MooseX::Types::Moose qw(HashRef Int);
  72     use MooseX::Types -declare=>[qw(Range RangedInt)];
  73
  74     ## Minor change from docs to avoid additional test dependencies
  75     subtype Range,
  76         as HashRef[Int],
  77         where {
  78             my ($range) = @_;
  79             return $range->{max} > $range->{min};
  80         },
  81         message { "Not a Valid range [ $_->{max} not > $_->{min} ] " };
  82
  83     subtype RangedInt,
  84         as Parameterizable[Int, Range],
  85         where {
  86             my ($value, $range) = @_;
  87             return ($value >= $range->{min} &&
  88              $value <= $range->{max});
  89         };
  90
  91     Test::More::ok RangedInt([{min=>10,max=>100}])->check(50);
  92     Test::More::ok !RangedInt([{min=>50, max=>75}])->check(99);
  93
  94     eval {
  95         Test::More::ok !RangedInt([{min=>99, max=>10}])->check(10);
  96     };
  97
  98     Test::More::ok $@, 'There was an error';
  99     Test::More::like $@, qr(Not a Valid range), 'Correct custom error';
 100
 101     Test::More::ok RangedInt([min=>10,max=>100])->check(50);
 102     Test::More::ok ! RangedInt([min=>50, max=>75])->check(99);
 103
 104     eval {
 105         RangedInt([min=>99, max=>10])->check(10);
 106     };
 107
 108     Test::More::ok $@, 'There was an error';
 109     Test::More::like $@, qr(Not a Valid range), 'Correct custom error';
 110
 111
 112 }
 113
 114
 115 done_testing;
 116
 117
 118 __END__
 119
 120 use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet PositiveUniqueInt )];
 121
 122 subtype Set,
 123   as class_type("Set::Scalar");
 124
 125 subtype UniqueInt,
 126   as Parameterizable[Int, Set],
 127   where {
 128     my ($int, $set) = @_;
 129     !$set->has($int);
 130   };
 131
 132 subtype PositiveSet,
 133   as Set,
 134   where {
 135     my ($set) = @_;
 136     ! grep { $_ < 0 } $set->members;
 137   };
 138
 139 subtype PositiveUniqueInt,
 140   as UniqueInt[PositiveSet];
 141
 142 my $set = Set::Scalar->new(-1,-2,1,2,3);
 143 my $positive_set = Set::Scalar->new(1,2,3);
 144 my $negative_set = Set::Scalar->new(-1,-2,-3);
 145
 146 ok Set->check($set),
 147  'Is a Set';
 148
 149 ok Set->check($positive_set),
 150  'Is a Set';
 151
 152 ok Set->check($negative_set),
 153  'Is a Set';
 154
 155 ok !PositiveSet->check($set),
 156  'Is Not a Positive Set';
 157
 158 ok PositiveSet->check($positive_set),
 159  'Is a Positive Set';
 160
 161 ok !PositiveSet->check($negative_set),
 162  'Is Not a Positive Set';
 163
 164 ok UniqueInt([$set])->check(100),
 165  '100 not in Set';
 166
 167 ok UniqueInt([$positive_set])->check(100),
 168  '100 not in Set';
 169
 170 ok UniqueInt([$negative_set])->check(100),
 171  '100 not in Set';
 172
 173 ok UniqueInt([$set])->check(-99),
 174  '-99 not in Set';
 175
 176 ok UniqueInt([$positive_set])->check(-99),
 177  '-99 not in Set';
 178
 179 ok UniqueInt([$negative_set])->check(-99),
 180   '-99 not in Set';
 181
 182 ok !UniqueInt([$set])->check(2),
 183  '2 in Set';
 184
 185 ok !UniqueInt([$positive_set])->check(2),
 186  '2 in Set';
 187
 188 ok UniqueInt([$negative_set])->check(2),
 189   '2 not in Set';
 190
 191
 192 __END__
 193
 194 ok UniqueInt([$set])->check(100);  ## Okay, 100 isn't in (1,2,3)
 195 ok UniqueInt([$set])->check(-99);  ## Okay, -99 isn't in (1,2,3)
 196 ok !UniqueInt([$set])->check(2);  ## Not OK, 2 is in (1,2,3)
 197
 198 ok PositiveUniqueInt([$set])->check(100);  ## Okay, 100 isn't in (1,2,3)
 199 ok !PositiveUniqueInt([$set])->check(-99);  ## Not OK, -99 not Positive Int
 200 ok !PositiveUniqueInt([$set])->check(2);  ## Not OK, 2 is in (1,2,3)
 201
 202 my $negative_set = Set::Scalar->new(-1,-2,-3);
 203
 204 ok UniqueInt([$negative_set])->check(100);  ## Throws exception
 205