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
119
120
121
|
use strict;
$| = 1;
print "1..21\n";
{
my %def = eval { foo() };
ok( ! $@,
"Error calling foo(): $@\n" );
ok( $def{a} == 1,
"Parameter 'a' was altered: $def{a}\n" );
ok( $def{b} == 2,
"Parameter 'b' was altered: $def{b}\n" );
ok( $def{c} == 42,
"No default (or incorrect default) assigned for parameter 'c': $def{c}\n" );
ok( $def{d} == 0,
"No default (or incorrect default) assigned for parameter 'd': $def{d}\n" );
}
{
my $def = eval { foo() };
ok( ! $@,
"Error calling foo(): $@\n" );
ok( $def->{a} == 1,
"Parameter 'a' was altered: $def->{a}\n" );
ok( $def->{b} == 2,
"Parameter 'b' was altered: $def->{b}\n" );
ok( $def->{c} == 42,
"No default (or incorrect default) assigned for parameter 'c': $def->{c}\n" );
ok( $def->{d} == 0,
"No default (or incorrect default) assigned for parameter 'd': $def->{d}\n" );
}
{
my @def = eval { bar() };
ok( ! $@,
"Error calling bar(): $@\n" );
ok( $def[0] == 1,
"1st parameter was altered: $def[0]\n" );
ok( $def[1] == 2,
"2nd parameter was altered: $def[1]\n" );
ok( $def[2] == 42,
"No default (or incorrect default) assigned for 3rd parameter: $def[2]\n" );
ok( $def[3] == 0,
"No default (or incorrect default) assigned for 4rd parameter: $def[0]\n" );
}
{
my $def = eval { bar() };
ok( ! $@,
"Error calling bar(): $@\n" );
ok( $def->[0] == 1,
"1st parameter was altered: $def->[0]\n" );
ok( $def->[1] == 2,
"2nd parameter was altered: $def->[1]\n" );
ok( $def->[2] == 42,
"No default (or incorrect default) assigned for 3rd parameter: $def->[2]\n" );
ok( $def->[3] == 0,
"No default (or incorrect default) assigned for 4rd parameter: $def->[0]\n" );
}
# test that defaults containing refs return _copies_ of these refs
{
my $spec = { foobar => { default => [] } };
my $test1 = validate_with(params => [], spec => $spec);
$test1->{foobar} = ['x'];
my $test2 = validate_with(params => [], spec => $spec);
$test2->{foobar} = ['y'];
ok($test1->{foobar}[0] eq 'x');
}
sub foo
{
my @params = ( a => 1, b => 2 );
return validate( @params, { a => 1,
b => { default => 99 },
c => { optional => 1, default => 42 },
d => { default => 0 },
} );
}
sub bar
{
my @params = ( 1, 2 );
return validate_pos( @params, 1, { default => 99 }, { default => 42 }, { default => 0 } );
}
sub ok
{
my $ok = !!shift;
use vars qw($TESTNUM);
$TESTNUM++;
print "not "x!$ok, "ok $TESTNUM\n";
print "@_\n" if !$ok;
}
1;
|
