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