1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
use strict;
use warnings;
use Test::More;
use Test::Fatal;
eval q{
package Local::TypeLibrary;
use Exporter 'import';
use MooX::Types::MooseLike ();
MooX::Types::MooseLike::register_types([{
name => 'Flibble',
test => sub { $_[0] =~ /^flibble$/i },
message => sub { 'Unflibble' },
inflate => 0,
}], __PACKAGE__);
$INC{'Local/TypeLibrary.pm'} = __FILE__;
1;
} or die $@;
eval q{
package Local::TestClass;
use Moo;
use Local::TypeLibrary 'Flibble';
has flibble => (is => 'ro', isa => Flibble);
1;
} or die $@;
is(
exception { Local::TestClass->new(flibble => 'fliBBle') },
undef,
'value which should not violate type constraint',
);
like(
exception { Local::TestClass->new(flibble => 'monkey') },
qr{^isa check for "flibble" failed: Unflibble},
'value which should violate type constraint',
);
eval q{ require Moose } or do {
note "Moose not available; skipping actual inflation tests";
done_testing;
exit;
};
is(
exception { Local::TestClass->new(flibble => 'fliBBle') },
undef,
'Moose loaded; value which should not violate type constraint',
);
like(
exception { Local::TestClass->new(flibble => 'monkey') },
qr{^isa check for "flibble" failed: Unflibble},
'Moose loaded; value which should violate type constraint',
);
my $tc = do {
# Suppress distracting warnings from within Moose
local $SIG{__WARN__} = sub { 0 };
Local::TestClass->meta->get_attribute('flibble')->type_constraint;
};
is(
$tc->name,
'__ANON__',
'type constraint inflation results in an anonymous type',
);
ok($tc->check('Flibble'), 'Moose::Meta::TypeConstraint works (1)');
ok($tc->check('FLIBBLE'), 'Moose::Meta::TypeConstraint works (2)');
ok(!$tc->check('Monkey'), 'Moose::Meta::TypeConstraint works (3)');
ok(!$tc->check([]), 'Moose::Meta::TypeConstraint works (4)');
done_testing;
|
