Commit | Line | Data |
d5598ade |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a28e50e4 |
6 | use Test::More; |
b10dde3a |
7 | use Test::Fatal; |
d5598ade |
8 | |
7ff56534 |
9 | |
d5598ade |
10 | # RT #37569 |
11 | |
12 | { |
13 | package MyObject; |
14 | use Moose; |
15 | |
16 | package Foo; |
17 | use Moose; |
18 | use Moose::Util::TypeConstraints; |
19 | |
20 | subtype 'MyArrayRef' |
21 | => as 'ArrayRef' |
22 | => where { defined $_->[0] } |
d03bd989 |
23 | => message { ref $_ ? "ref: ". ref $_ : 'scalar' } # stringy |
d5598ade |
24 | ; |
25 | |
26 | subtype 'MyObjectType' |
27 | => as 'Object' |
28 | => where { $_->isa('MyObject') } |
29 | => message { |
30 | if ( $_->isa('SomeObject') ) { |
31 | return 'More detailed error message'; |
32 | } |
33 | elsif ( blessed $_ ) { |
34 | return 'Well it is an object'; |
35 | } |
36 | else { |
37 | return 'Doh!'; |
38 | } |
39 | } |
40 | ; |
41 | |
42 | type 'NewType' |
43 | => where { $_->isa('MyObject') } |
44 | => message { blessed $_ ? 'blessed' : 'scalar' } |
45 | ; |
46 | |
47 | has 'obj' => ( is => 'rw', isa => 'MyObjectType' ); |
48 | has 'ar' => ( is => 'rw', isa => 'MyArrayRef' ); |
49 | has 'nt' => ( is => 'rw', isa => 'NewType' ); |
50 | } |
51 | |
52 | my $foo = Foo->new; |
53 | my $obj = MyObject->new; |
54 | |
b10dde3a |
55 | like( exception { |
21256595 |
56 | $foo->ar( [] ); |
b10dde3a |
57 | }, qr/Attribute \(ar\) does not pass the type constraint because: ref: ARRAY/, '... got the right error message' ); |
d5598ade |
58 | |
b10dde3a |
59 | like( exception { |
21256595 |
60 | $foo->obj($foo); # Doh! |
b10dde3a |
61 | }, qr/Attribute \(obj\) does not pass the type constraint because: Well it is an object/, '... got the right error message' ); |
d5598ade |
62 | |
b10dde3a |
63 | like( exception { |
21256595 |
64 | $foo->nt($foo); # scalar |
b10dde3a |
65 | }, qr/Attribute \(nt\) does not pass the type constraint because: blessed/, '... got the right error message' ); |
d5598ade |
66 | |
a28e50e4 |
67 | done_testing; |