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
|
use strict;
use warnings;
use Test::More;
use Params::Validate qw( validate );
{
my $e = _test_args(
pos_int => 42,
string => 'foo',
);
is(
$e,
q{},
'no error with good args'
);
}
{
my $e = _test_args(
pos_int => 42,
string => [],
);
like(
$e,
qr/The 'string' parameter \("ARRAY\(.+\)"\) to main::validate1 did not pass the 'string' callback: ARRAY\(.+\) is not a string/,
'got error for bad string'
);
}
{
my $e = _test_args(
pos_int => 0,
string => 'foo',
);
like(
$e,
qr/\QThe 'pos_int' parameter ("0") to main::validate1 did not pass the 'pos_int' callback: 0 is not a positive integer/,
'got error for bad pos int (0)'
);
}
{
my $e = _test_args(
pos_int => 'bar',
string => 'foo',
);
like(
$e,
qr/\QThe 'pos_int' parameter ("bar") to main::validate1 did not pass the 'pos_int' callback: bar is not a positive integer/,
'got error for bad pos int (bar)'
);
}
{
my $e = do {
local $@;
eval { validate2( string => [] ); };
$@;
};
is_deeply(
$e,
{ error => 'not a string' },
'ref thrown by callback is preserved, not stringified'
);
}
sub _test_args {
local $@;
eval { validate1(@_) };
return $@;
}
sub validate1 {
validate(
@_, {
pos_int => {
callbacks => {
pos_int => sub {
$_[0] =~ /^[1-9][0-9]*$/
or die "$_[0] is not a positive integer\n";
},
},
},
string => {
callbacks => {
string => sub {
( defined $_[0] && !ref $_[0] && length $_[0] )
or die "$_[0] is not a string\n";
},
},
},
}
);
}
sub validate2 {
validate(
@_, {
string => {
callbacks => {
string => sub {
( defined $_[0] && !ref $_[0] && length $_[0] )
or die { error => 'not a string' };
},
},
},
}
);
}
done_testing();
|
