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
|
BEGIN {
$ENV{PV_TEST_PERL} = 1;
}
use strict;
use warnings;
use Params::Validate qw(validate validate_with);
use Test::More;
my $ucfirst_normalizer = sub { return ucfirst lc $_[0] };
sub sub1 {
my %args = validate_with(
params => \@_,
spec => { PaRaMkEy => 1 },
normalize_keys => $ucfirst_normalizer
);
return $args{Paramkey};
}
sub sub2 {
# verify that normalize_callback surpresses ignore_case
my %args = validate_with(
params => \@_,
spec => { PaRaMkEy => 1 },
normalize_keys => $ucfirst_normalizer,
ignore_case => 1
);
return $args{Paramkey};
}
sub sub3 {
# verify that normalize_callback surpresses strip_leading
my %args = validate_with(
params => \@_,
spec => { -PaRaMkEy => 1 },
normalize_keys => $ucfirst_normalizer,
strip_leading => '-'
);
return $args{-paramkey};
}
sub sub4 {
my %args = validate_with(
params => \@_,
spec => { foo => 1 },
normalize_keys => sub {undef}
);
}
sub sub5 {
my %args = validate_with(
params => \@_,
spec => { foo => 1 },
normalize_keys => sub { return 'a' },
);
}
ok( eval { sub1( pArAmKeY => 1 ) } );
ok( eval { sub2( pArAmKeY => 1 ) } );
ok( eval { sub3( -pArAmKeY => 1 ) } );
eval { sub4( foo => 5 ) };
like( $@, qr/normalize_keys.+a defined value/ );
eval { sub5( foo => 5, bar => 5 ) };
like( $@, qr/normalize_keys.+already exists/ );
done_testing();
|
