t/024-isa.t

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