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     ## Create a type constraint that is a string but parameterizes an integer
  15     ## that is used as a maximum length constraint on that string, similar to
  16     ## an SQL Varchar type.
  17
  18     subtype Varchar,
  19       as Parameterizable[Str,Int],
  20       where {
  21         my($string, $int) = @_;
  22         $int >= length($string) ? 1:0;
  23       },
  24       message { "'$_' is too long"  };
  25
  26     coerce Varchar,
  27       from ArrayRef,
  28       via {
  29         my ($arrayref, $int) = @_;
  30         join('', @$arrayref);
  31       };
  32
  33     my $varchar_five = Varchar[5];
  34
  35     Test::More::ok $varchar_five->check('four');
  36     Test::More::ok ! $varchar_five->check('verylongstrong');
  37
  38     my $varchar_ten = Varchar[10];
  39
  40     Test::More::ok $varchar_ten->check( 'X' x 9 );
  41     Test::More::ok ! $varchar_ten->check( 'X' x 12 );
  42
  43     has varchar_five => (isa=>$varchar_five, is=>'ro', coerce=>1);
  44     has varchar_ten => (isa=>Varchar[10], is=>'ro');
  45
  46     my $object1 = __PACKAGE__->new(
  47         varchar_five => '1234',
  48         varchar_ten => '123456789',
  49     );
  50
  51     eval {
  52         my $object2 = __PACKAGE__->new(
  53             varchar_five => '12345678',
  54             varchar_ten => '123456789',
  55         );
  56     };
  57
  58     Test::More::ok $@, 'There was an error';
  59     Test::More::like $@, qr('12345678' is too long), 'Correct custom error';
  60 }
  61
  62 done_testing;
  63
  64
  65 __END__
  66
  67 use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet PositiveUniqueInt )];
  68
  69 subtype Set,
  70   as class_type("Set::Scalar");
  71
  72 subtype UniqueInt,
  73   as Parameterizable[Int, Set],
  74   where {
  75     my ($int, $set) = @_;
  76     !$set->has($int);
  77   };
  78
  79 subtype PositiveSet,
  80   as Set,
  81   where {
  82     my ($set) = @_;
  83     ! grep { $_ < 0 } $set->members;
  84   };
  85
  86 subtype PositiveUniqueInt,
  87   as UniqueInt[PositiveSet];
  88
  89 my $set = Set::Scalar->new(-1,-2,1,2,3);
  90 my $positive_set = Set::Scalar->new(1,2,3);
  91 my $negative_set = Set::Scalar->new(-1,-2,-3);
  92
  93 ok Set->check($set),
  94  'Is a Set';
  95
  96 ok Set->check($positive_set),
  97  'Is a Set';
  98
  99 ok Set->check($negative_set),
 100  'Is a Set';
 101
 102 ok !PositiveSet->check($set),
 103  'Is Not a Positive Set';
 104
 105 ok PositiveSet->check($positive_set),
 106  'Is a Positive Set';
 107
 108 ok !PositiveSet->check($negative_set),
 109  'Is Not a Positive Set';
 110
 111 ok UniqueInt([$set])->check(100),
 112  '100 not in Set';
 113
 114 ok UniqueInt([$positive_set])->check(100),
 115  '100 not in Set';
 116
 117 ok UniqueInt([$negative_set])->check(100),
 118  '100 not in Set';
 119
 120 ok UniqueInt([$set])->check(-99),
 121  '-99 not in Set';
 122
 123 ok UniqueInt([$positive_set])->check(-99),
 124  '-99 not in Set';
 125
 126 ok UniqueInt([$negative_set])->check(-99),
 127   '-99 not in Set';
 128
 129 ok !UniqueInt([$set])->check(2),
 130  '2 in Set';
 131
 132 ok !UniqueInt([$positive_set])->check(2),
 133  '2 in Set';
 134
 135 ok UniqueInt([$negative_set])->check(2),
 136   '2 not in Set';
 137
 138
 139 __END__
 140
 141 ok UniqueInt([$set])->check(100);  ## Okay, 100 isn't in (1,2,3)
 142 ok UniqueInt([$set])->check(-99);  ## Okay, -99 isn't in (1,2,3)
 143 ok !UniqueInt([$set])->check(2);  ## Not OK, 2 is in (1,2,3)
 144
 145 ok PositiveUniqueInt([$set])->check(100);  ## Okay, 100 isn't in (1,2,3)
 146 ok !PositiveUniqueInt([$set])->check(-99);  ## Not OK, -99 not Positive Int
 147 ok !PositiveUniqueInt([$set])->check(2);  ## Not OK, 2 is in (1,2,3)
 148
 149 my $negative_set = Set::Scalar->new(-1,-2,-3);
 150
 151 ok UniqueInt([$negative_set])->check(100);  ## Throws exception
 152