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