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.3,
  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 => [
  33             \undef,
  34             1.5,
  35             "true",
  36             "false",
  37             "t",
  38             "f",
  39             \"foo",
  40             sub { die },
  41             qr/^1?$|^(11+?)\1+$/,
  42             [],
  43             {},
  44             \do { my $v = 1 },
  45             Test::Builder->new,
  46         ],
  47     },
  48
  49     Undef => {
  50         valid   => [undef],
  51         invalid => [
  52             \undef,
  53             0,
  54             '',
  55             1.5,
  56             "undef",
  57             \"undef",
  58             sub { die },
  59             qr/^1?$|^(11+?)\1+$/,
  60             [],
  61             {},
  62             \do { my $v = undef },
  63             Test::Builder->new,
  64         ],
  65     },
  66
  67     Defined => {
  68         # populated later with the values from Undef
  69         #valid   => [],
  70         #invalid => [],
  71     },
  72
  73     Value => {
  74         valid   => [],
  75         invalid => [],
  76     },
  77
  78     Num => {
  79         valid   => [],
  80         invalid => [],
  81     },
  82
  83     Int => {
  84         valid   => [],
  85         invalid => [],
  86     },
  87
  88     Str => {
  89         valid   => [],
  90         invalid => [],
  91     },
  92
  93     ClassName => {
  94         valid   => [],
  95         invalid => [],
  96     },
  97
  98     Ref => {
  99         valid   => [],
 100         invalid => [],
 101     },
 102
 103     ScalarRef => {
 104         valid   => [],
 105         invalid => [],
 106     },
 107
 108     ArrayRef => {
 109         valid   => [],
 110         invalid => [],
 111     },
 112
 113     HashRef => {
 114         valid   => [],
 115         invalid => [],
 116     },
 117
 118     CodeRef => {
 119         valid   => [],
 120         invalid => [],
 121     },
 122
 123     RegexpRef => {
 124         valid   => [],
 125         invalid => [],
 126     },
 127
 128     GlobRef => {
 129         valid   => [],
 130         invalid => [],
 131     },
 132
 133     FileHandle => {
 134         valid   => [],
 135         invalid => [],
 136     },
 137
 138     Object => {
 139         valid   => [],
 140         invalid => [],
 141     },
 142 );
 143
 144 $values_for_type{Item}{valid} = $values_for_type{Any}{valid};
 145 $values_for_type{Defined}{valid} = $values_for_type{Undef}{invalid};
 146 $values_for_type{Defined}{invalid} = $values_for_type{Undef}{valid};
 147
 148 my $plan = 0;
 149 $plan += 5 * @{ $values_for_type{$_}{valid} }   for keys %values_for_type;
 150 $plan += 4 * @{ $values_for_type{$_}{invalid} } for keys %values_for_type;
 151 $plan++; # can_ok
 152
 153 plan tests => $plan;
 154
 155 do {
 156     package Class;
 157     use Mouse;
 158
 159     for my $type (keys %values_for_type) {
 160         has $type => (
 161             is  => 'rw',
 162             isa => $type,
 163         );
 164     }
 165 };
 166
 167 can_ok(Class => keys %values_for_type);
 168
 169 for my $type (keys %values_for_type) {
 170     for my $value (@{ $values_for_type{$type}{valid} }) {
 171         lives_ok {
 172             my $via_new = Class->new($type => $value);
 173             is_deeply($via_new->$type, $value, "correctly set a $type in the constructor");
 174         };
 175
 176         lives_ok {
 177             my $via_set = Class->new;
 178             is($via_set->$type, undef, "initially unset");
 179             $via_set->$type($value);
 180             is_deeply($via_set->$type, $value, "correctly set a $type in the setter");
 181         };
 182     }
 183
 184     for my $value (@{ $values_for_type{$type}{invalid} }) {
 185         my $display = defined($value) ? $value : 'undef';
 186         my $via_new;
 187         throws_ok {
 188             $via_new = Class->new($type => $value);
 189         } qr/Attribute \($type\) does not pass the type constraint because: Validation failed for '$type' failed with value \Q$display\E/;
 190         is($via_new, undef, "no object created");
 191
 192         my $via_set = Class->new;
 193         throws_ok {
 194             $via_set->$type($value);
 195         } qr/Attribute \($type\) does not pass the type constraint because: Validation failed for '$type' failed with value \Q$display\E/;
 196
 197         is($via_set->$type, undef, "value for $type not set");
 198     }
 199 }
 200