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     package Test::MooseX::Types::Parameterizable::Subtypes;
 116
 117     use Moose;
 118     use MooseX::Types::Parameterizable qw(Parameterizable);
 119     use MooseX::Types::Moose qw(HashRef Int);
 120     use MooseX::Types -declare=>[qw(Range RangedInt PositiveRangedInt
 121         PositiveInt PositiveRange PositiveRangedInt2 )];
 122
 123     ## Minor change from docs to avoid additional test dependencies
 124     subtype Range,
 125         as HashRef[Int],
 126         where {
 127             my ($range) = @_;
 128             return $range->{max} > $range->{min};
 129         },
 130         message { "Not a Valid range [ $_->{max} not > $_->{min} ] " };
 131
 132     subtype RangedInt,
 133         as Parameterizable[Int, Range],
 134         where {
 135             my ($value, $range) = @_;
 136             return ($value >= $range->{min} &&
 137              $value <= $range->{max});
 138         };
 139
 140     subtype PositiveRangedInt,
 141         as RangedInt,
 142         where {
 143             shift >= 0;
 144         };
 145
 146     Test::More::ok PositiveRangedInt([{min=>10,max=>100}])->check(50);
 147     Test::More::ok !PositiveRangedInt([{min=>50, max=>75}])->check(99);
 148
 149     eval {
 150         Test::More::ok !PositiveRangedInt([{min=>99, max=>10}])->check(10);
 151     };
 152
 153     Test::More::ok $@, 'There was an error';
 154     Test::More::like $@, qr(Not a Valid range), 'Correct custom error';
 155
 156     Test::More::ok PositiveRangedInt([min=>10,max=>100])->check(50);
 157     Test::More::ok ! PositiveRangedInt([min=>50, max=>75])->check(99);
 158
 159     eval {
 160         PositiveRangedInt([min=>99, max=>10])->check(10);
 161     };
 162
 163     Test::More::ok $@, 'There was an error';
 164     Test::More::like $@, qr(Not a Valid range), 'Correct custom error';
 165
 166     Test::More::ok !PositiveRangedInt([{min=>-10, max=>75}])->check(-5);
 167
 168     ## Subtype of Int for positive numbers
 169     subtype PositiveInt,
 170         as Int,
 171         where {
 172             my ($value, $range) = @_;
 173             return $value >= 0;
 174         };
 175
 176     ## subtype Range to re-parameterize Range with subtypes.  Minor change from
 177     ## docs to reduce test dependencies
 178
 179     subtype PositiveRange,
 180       as Range[PositiveInt],
 181       message { "[ $_->{max} not > $_->{min} ] is not a positive range " };
 182
 183     ## create subtype via reparameterizing
 184     subtype PositiveRangedInt2,
 185         as RangedInt[PositiveRange];
 186
 187     Test::More::ok PositiveRangedInt2([{min=>10,max=>100}])->check(50);
 188     Test::More::ok !PositiveRangedInt2([{min=>50, max=>75}])->check(99);
 189
 190     eval {
 191         Test::More::ok !PositiveRangedInt2([{min=>99, max=>10}])->check(10);
 192     };
 193
 194     Test::More::ok $@, 'There was an error';
 195     Test::More::like $@, qr(not a positive range), 'Correct custom error';
 196
 197     Test::More::ok !PositiveRangedInt2([{min=>10, max=>75}])->check(-5);
 198
 199     ## See t/02-types-parameterizable-extended.t for remaining examples tests
 200 }
 201
 202 {
 203     package Test::MooseX::Types::Parameterizable::Coercions;
 204
 205     use Moose;
 206     use MooseX::Types::Parameterizable qw(Parameterizable);
 207     use MooseX::Types::Moose qw(HashRef ArrayRef Object Str Int);
 208     use MooseX::Types -declare=>[qw(Varchar MySpecialVarchar )];
 209
 210
 211     subtype Varchar,
 212       as Parameterizable[Str, Int],
 213       where {
 214         my($string, $int) = @_;
 215         $int >= length($string) ? 1:0;
 216       },
 217       message { "'$_' is too long"  };
 218
 219
 220     coerce Varchar,
 221       from Object,
 222       via { "$_"; },  ## stringify the object
 223       from ArrayRef,
 224       via { join '',@$_ };  ## convert array to string
 225
 226     subtype MySpecialVarchar,
 227       as Varchar;
 228
 229     coerce MySpecialVarchar,
 230       from HashRef,
 231       via { join '', keys %$_ };
 232
 233
 234     Test::More::is Varchar([40])->coerce("abc"), 'abc';
 235     Test::More::is Varchar([40])->coerce([qw/d e f/]), 'def';
 236
 237     Test::More::is MySpecialVarchar([40])->coerce("abc"), 'abc';
 238     Test::More::is_deeply( MySpecialVarchar([40])->coerce([qw/d e f/]), [qw/d e f/]);
 239     Test::More::is MySpecialVarchar([40])->coerce({a=>1, b=>2}), 'ab';
 240 }
 241
 242 {
 243     package Test::MooseX::Types::Parameterizable::Recursion;
 244
 245     use Moose;
 246     use MooseX::Types::Parameterizable qw(Parameterizable);
 247     use MooseX::Types::Moose qw(  );
 248     use MooseX::Types -declare=>[qw(  )];
 249
 250     ## To be done when I can think of a use case
 251 }
 252
 253 done_testing;
 254