Correct error message to include 'Maybe' as implemented parametric type.
[gitmo/Mouse.git] / t / 024-isa.t
CommitLineData
7e68124f 1#!/usr/bin/env perl
2use strict;
3use warnings;
9f15f9eb 4use Test::More;
d2e2ac48 5use IO::Handle;
eab81545 6use Test::Exception;
7e68124f 7
dfaf3196 8my @types = qw/Any Item Bool Undef Defined Value Num Int Str ClassName
9 Ref ScalarRef ArrayRef HashRef CodeRef RegexpRef GlobRef
10 FileHandle Object/;
11
12my @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 36my %values_for_type;
7e68124f 37
dfaf3196 38for (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
50my $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
55plan tests => $plan;
56
7e68124f 57do {
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 69can_ok(Class => @types);
7e68124f 70
dfaf3196 71for 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