t/05-pod-examples.t

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