t/024-isa.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5 use Test::Exception;
   6
   7 my %values_for_type = (
   8     Any => {
   9         valid   => [
  10             undef,
  11             \undef,
  12             1.0,
  13             "foo",
  14             \"foo",
  15             sub { die },
  16             qr/^1?$|^(11+?)\1+$/,
  17             [],
  18             {},
  19             \do { my $v },
  20             Test::Builder->new,
  21         ],
  22         invalid => [],
  23     },
  24
  25     Item => {
  26         #valid   => [], # populated later with the values from Any
  27         invalid => [],
  28     },
  29
  30     Bool => {
  31         valid   => [undef, "", 1, 0, "1", "0"],
  32         invalid => [1.5, "true", "false", "t", "f", ],
  33     },
  34
  35     Undef => {
  36         valid   => [],
  37         invalid => [],
  38     },
  39
  40     Defined => {
  41         valid   => [],
  42         invalid => [],
  43     },
  44
  45     Value => {
  46         valid   => [],
  47         invalid => [],
  48     },
  49
  50     Num => {
  51         valid   => [],
  52         invalid => [],
  53     },
  54
  55     Int => {
  56         valid   => [],
  57         invalid => [],
  58     },
  59
  60     Str => {
  61         valid   => [],
  62         invalid => [],
  63     },
  64
  65     ClassName => {
  66         valid   => [],
  67         invalid => [],
  68     },
  69
  70     Ref => {
  71         valid   => [],
  72         invalid => [],
  73     },
  74
  75     ScalarRef => {
  76         valid   => [],
  77         invalid => [],
  78     },
  79
  80     ArrayRef => {
  81         valid   => [],
  82         invalid => [],
  83     },
  84
  85     HashRef => {
  86         valid   => [],
  87         invalid => [],
  88     },
  89
  90     CodeRef => {
  91         valid   => [],
  92         invalid => [],
  93     },
  94
  95     RegexpRef => {
  96         valid   => [],
  97         invalid => [],
  98     },
  99
 100     GlobRef => {
 101         valid   => [],
 102         invalid => [],
 103     },
 104
 105     FileHandle => {
 106         valid   => [],
 107         invalid => [],
 108     },
 109
 110     Object => {
 111         valid   => [],
 112         invalid => [],
 113     },
 114 );
 115
 116 $values_for_type{Item}{valid} = $values_for_type{Any}{valid};
 117
 118 my $plan = 0;
 119 $plan += 5 * @{ $values_for_type{$_}{valid} }   for keys %values_for_type;
 120 $plan += 4 * @{ $values_for_type{$_}{invalid} } for keys %values_for_type;
 121 $plan++; # can_ok
 122
 123 plan tests => $plan;
 124
 125 do {
 126     package Class;
 127     use Mouse;
 128
 129     for my $type (keys %values_for_type) {
 130         has $type => (
 131             is  => 'rw',
 132             isa => $type,
 133         );
 134     }
 135 };
 136
 137 can_ok(Class => keys %values_for_type);
 138
 139 for my $type (keys %values_for_type) {
 140     for my $value (@{ $values_for_type{$type}{valid} }) {
 141         lives_ok {
 142             my $via_new = Class->new($type => $value);
 143             is_deeply($via_new->$type, $value, "correctly set a $type in the constructor");
 144         };
 145
 146         lives_ok {
 147             my $via_set = Class->new;
 148             is($via_set->$type, undef, "initially unset");
 149             $via_set->$type($value);
 150             is_deeply($via_set->$type, $value, "correctly set a $type in the setter");
 151         };
 152     }
 153
 154     for my $value (@{ $values_for_type{$type}{invalid} }) {
 155         my $via_new;
 156         throws_ok {
 157             $via_new = Class->new($type => $value);
 158         } qr/Attribute \($type\) does not pass the type constraint because: Validation failed for '$type' failed with value \Q$value\E/;
 159         is($via_new, undef, "no object created");
 160
 161         my $via_set = Class->new;
 162         throws_ok {
 163             $via_set->$type($value);
 164         } qr/Attribute \($type\) does not pass the type constraint because: Validation failed for '$type' failed with value \Q$value\E/;
 165
 166         is($via_set->$type, undef, "value for $type not set");
 167     }
 168 }
 169