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