Commit | Line | Data |
7e68124f |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
9f15f9eb |
4 | use Test::More; |
7e68124f |
5 | use Test::Exception; |
6 | |
dfaf3196 |
7 | my @types = qw/Any Item Bool Undef Defined Value Num Int Str ClassName |
8 | Ref ScalarRef ArrayRef HashRef CodeRef RegexpRef GlobRef |
9 | FileHandle Object/; |
10 | |
11 | my @type_values = ( |
12 | undef , [qw/Any Item Undef Bool/], |
27a22464 |
13 | 0 => [qw/Any Item Defined Bool Value Num Int Str/], |
14 | 1 => [qw/Any Item Defined Bool Value Num Int Str/], |
15 | 1.5 => [qw/Any Item Defined Value Num Str/], |
dfaf3196 |
16 | '' => [qw/Any Item Defined Bool Value Str/], |
17 | 't' => [qw/Any Item Defined Value Str/], |
18 | 'f' => [qw/Any Item Defined Value Str/], |
19 | 'undef' => [qw/Any Item Defined Value Str/], |
20 | 'Test::More' => [qw/Any Item Defined Value Str ClassName/], |
21 | \undef => [qw/Any Item Defined Ref ScalarRef/], |
22 | \1 => [qw/Any Item Defined Ref ScalarRef/], |
23 | \"foo" => [qw/Any Item Defined Ref ScalarRef/], |
24 | [], => [qw/Any Item Defined Ref ArrayRef/], |
25 | [undef, \1] => [qw/Any Item Defined Ref ArrayRef/], |
26 | {} => [qw/Any Item Defined Ref HashRef/], |
27 | sub { die } => [qw/Any Item Defined Ref CodeRef/], |
28 | qr/.*/ => [qw/Any Item Defined Ref RegexpRef/], |
29 | \*STDOUT => [qw/Any Item Defined Ref GlobRef FileHandle/], |
30 | Test::Builder->new => [qw/Any Item Defined Ref Object/], |
31 | ); |
7e68124f |
32 | |
dfaf3196 |
33 | my %values_for_type; |
7e68124f |
34 | |
dfaf3196 |
35 | for (my $i = 1; $i < @type_values; $i += 2) { |
36 | my ($value, $valid_types) = @type_values[$i-1, $i]; |
37 | my %is_invalid = map { $_ => 1 } @types; |
38 | delete @is_invalid{@$valid_types}; |
7e68124f |
39 | |
dfaf3196 |
40 | push @{ $values_for_type{$_}{invalid} }, $value |
41 | for grep { $is_invalid{$_} } @types; |
7e68124f |
42 | |
dfaf3196 |
43 | push @{ $values_for_type{$_}{valid} }, $value |
44 | for grep { !$is_invalid{$_} } @types; |
45 | } |
9f15f9eb |
46 | |
47 | my $plan = 0; |
dfaf3196 |
48 | $plan += 5 * @{ $values_for_type{$_}{valid} || [] } for @types; |
49 | $plan += 4 * @{ $values_for_type{$_}{invalid} || [] } for @types; |
9f15f9eb |
50 | $plan++; # can_ok |
51 | |
52 | plan tests => $plan; |
53 | |
7e68124f |
54 | do { |
55 | package Class; |
56 | use Mouse; |
57 | |
dfaf3196 |
58 | for my $type (@types) { |
7e68124f |
59 | has $type => ( |
60 | is => 'rw', |
61 | isa => $type, |
62 | ); |
63 | } |
64 | }; |
65 | |
dfaf3196 |
66 | can_ok(Class => @types); |
7e68124f |
67 | |
dfaf3196 |
68 | for my $type (@types) { |
7e68124f |
69 | for my $value (@{ $values_for_type{$type}{valid} }) { |
70 | lives_ok { |
71 | my $via_new = Class->new($type => $value); |
72 | is_deeply($via_new->$type, $value, "correctly set a $type in the constructor"); |
73 | }; |
74 | |
75 | lives_ok { |
76 | my $via_set = Class->new; |
77 | is($via_set->$type, undef, "initially unset"); |
78 | $via_set->$type($value); |
79 | is_deeply($via_set->$type, $value, "correctly set a $type in the setter"); |
80 | }; |
81 | } |
82 | |
83 | for my $value (@{ $values_for_type{$type}{invalid} }) { |
f5fbe3cc |
84 | my $display = defined($value) ? $value : 'undef'; |
7e68124f |
85 | my $via_new; |
86 | throws_ok { |
87 | $via_new = Class->new($type => $value); |
f5fbe3cc |
88 | } qr/Attribute \($type\) does not pass the type constraint because: Validation failed for '$type' failed with value \Q$display\E/; |
7e68124f |
89 | is($via_new, undef, "no object created"); |
90 | |
91 | my $via_set = Class->new; |
92 | throws_ok { |
93 | $via_set->$type($value); |
f5fbe3cc |
94 | } qr/Attribute \($type\) does not pass the type constraint because: Validation failed for '$type' failed with value \Q$display\E/; |
7e68124f |
95 | |
96 | is($via_set->$type, undef, "value for $type not set"); |
97 | } |
98 | } |
99 | |