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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
=pod
=encoding utf-8
=head1 PURPOSE
Check type constraints can be made inlinable using L<Sub::Quote>.
=head1 DEPENDENCIES
Test is skipped if Sub::Quote is not available.
=head1 AUTHOR
Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENCE
This software is copyright (c) 2013-2014 by Toby Inkster.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
use strict;
use warnings;
use lib qw( ./lib ./t/lib ../inc ./inc );
use Test::More;
use Test::Requires "Sub::Quote";
use Test::TypeTiny;
use Sub::Quote;
use Type::Tiny;
use Types::Standard qw( ArrayRef Int );
my $Type1 = "Type::Tiny"->new(
name => "Type1",
constraint => quote_sub q{ $_[0] eq q(42) },
);
should_fail(41, $Type1);
should_pass(42, $Type1);
ok($Type1->can_be_inlined, 'constraint built using quote_sub and $_[0] can be inlined')
and note $Type1->inline_check('$value');
my $Type2 = "Type::Tiny"->new(
name => "Type2",
constraint => quote_sub q{ $_ eq q(42) },
);
should_fail(41, $Type2);
should_pass(42, $Type2);
ok($Type2->can_be_inlined, 'constraint built using quote_sub and $_[0] can be inlined')
and note $Type2->inline_check('$value');
my $Type3 = "Type::Tiny"->new(
name => "Type3",
constraint => quote_sub q{ my ($n) = @_; $n eq q(42) },
);
should_fail(41, $Type3);
should_pass(42, $Type3);
ok($Type3->can_be_inlined, 'constraint built using quote_sub and @_ can be inlined')
and note $Type3->inline_check('$value');
my $Type4 = "Type::Tiny"->new(
name => "Type4",
parent => Int,
constraint => quote_sub q{ $_[0] >= 42 },
);
should_fail(41, $Type4);
should_pass(42, $Type4);
should_pass(43, $Type4);
should_fail(44.4, $Type4);
ok($Type4->can_be_inlined, 'constraint built using quote_sub and parent type can be inlined')
and note $Type4->inline_check('$value');
my $Type5 = "Type::Tiny"->new(
name => "Type5",
parent => Int,
constraint => quote_sub q{ $_[0] >= $x }, { '$x' => \42 },
);
should_fail(41, $Type5);
should_pass(42, $Type5);
should_pass(43, $Type5);
should_fail(44.4, $Type5);
TODO: {
local $TODO = "captures not supported yet";
ok($Type5->can_be_inlined, 'constraint built using quote_sub and captures can be inlined');
};
my $Type6 = "Type::Tiny"->new(
name => "Type6",
parent => Int->create_child_type(constraint => sub { 999 }),
constraint => quote_sub q{ $_[0] >= 42 },
);
should_fail(41, $Type6);
should_pass(42, $Type6);
should_pass(43, $Type6);
should_fail(44.4, $Type6);
ok(!$Type6->can_be_inlined, 'constraint built using quote_sub and non-inlinable parent cannot be inlined');
my $Type7 = ArrayRef([Int]) & quote_sub q{ @$_ > 1 and @$_ < 4 };
should_pass([1,2,3], $Type7);
should_fail([1,2.1,3], $Type7);
should_fail([1], $Type7);
should_fail([1,2,3,4], $Type7);
ok($Type7->can_be_inlined, 'constraint built as an intersection of an inlinable type constraint and a quoted sub can be inlined');
note($Type7->inline_check('$VAR'));
done_testing;
|
