Commit | Line | Data |
7193dffb |
1 | #!perl |
2 | use warnings FATAL => 'all'; |
3 | use strict; |
4 | |
5 | use Test::More tests => 4; |
6 | use Test::Fatal; |
7 | |
8 | { |
9 | package MyTC; |
10 | |
11 | use Function::Parameters qw(:strict); |
12 | |
13 | method new( |
14 | $class: |
15 | $name, |
16 | $check, |
17 | $get_message = fun ($value) { |
18 | "Validation failed for constraint '$name' with value '$value'" |
19 | }, |
20 | ) { |
21 | bless { |
22 | name => $name, |
23 | check => $check, |
24 | get_message => $get_message, |
25 | }, $class |
26 | } |
27 | |
28 | method check($value) { |
29 | $self->{check}($value) |
30 | } |
31 | |
32 | method get_message($value) { |
33 | $self->{get_message}($value) |
34 | } |
35 | } |
36 | |
37 | use Function::Parameters do { |
38 | use Function::Parameters qw(:strict); |
39 | |
40 | my %Types = ( |
41 | TEvenNum => MyTC->new('even number' => fun ($n) { $n =~ /^[0-9]+\z/ && $n % 2 == 0 }), |
42 | TShortStr => MyTC->new('short string' => fun ($s) { length($s) < 10 }), |
43 | Any => MyTC->new('any value' => fun ($a) { 1 }), |
44 | ); |
45 | +{ |
46 | fun => { |
f7651a6e |
47 | strict => 1, |
7193dffb |
48 | reify_type => sub { $Types{ $_[0] } || $Types{Any} }, |
49 | }, |
50 | } |
51 | }; |
52 | |
53 | fun foo(TEvenNum $x, TShortStr $y) { |
54 | "$x/$y" |
55 | } |
56 | |
57 | is foo(42, "hello"), "42/hello"; |
58 | like exception { foo 41, "hello" }, qr{\bValidation failed for constraint 'even number' with value '41'}; |
59 | like exception { foo 42, "1234567890~" }, qr{\bValidation failed for constraint 'short string' with value '1234567890~'}; |
60 | like exception { foo 41, "1234567890~" }, qr{\bValidation failed for constraint 'even number' with value '41'}; |