package PVTests::Standard;
use strict;
use warnings;
use Params::Validate qw(:all);
use PVTests;
use Test::More 0.88;
my $String = 'foo';
my ( $v1, $v2, $v3, $v4 );
my $Foo = bless \$v1, 'Foo';
my $Bar = bless \$v2, 'Bar';
my $Baz = bless \$v3, 'Baz';
my $Quux = bless \$v4, 'Quux';
my @Tests = (
{
sub => 'sub1',
p => [ foo => 'a', bar => 'b' ],
expect => q{},
},
{
sub => 'sub1',
p => [ foo => 'a' ],
expect => qr|^Mandatory parameter 'bar' missing|,
},
{
sub => 'sub1',
p => [],
expect => qr|^Mandatory parameters .* missing|,
},
{
sub => 'sub1',
p => [ foo => 'a', bar => 'b', baz => 'c' ],
expect => qr|^The following parameter .* baz|,
},
{
sub => 'sub2',
p => [ foo => 'a', bar => 'b', baz => 'c' ],
expect => q{},
},
{
sub => 'sub2',
p => [ foo => 'a', bar => 'b' ],
expect => q{},
},
{
sub => 'sub2a',
p => [ foo => 'a', bar => 'b' ],
expect => q{},
},
{
sub => 'sub2a',
p => [ foo => 'a' ],
expect => q{},
},
# simple types
{
sub => 'sub3',
p => [
foo => 'a',
bar => [ 1, 2, 3 ],
baz => { a => 1 },
quux => 'yadda',
brax => {qw( a b c d )},
],
expect => q{},
},
{
sub => 'sub3',
p => [
foo => ['a'],
bar => [ 1, 2, 3 ],
baz => { a => 1 },
quux => 'yadda',
brax => {qw( a b c d )},
],
expect =>
qr|^The 'foo' parameter \("ARRAY\(0x[a-f0-9]+\)"\) to [\w:]+sub3 was an 'arrayref'.* types: scalar|,
},
{
sub => 'sub3',
p => [
foo => 'foobar',
bar => [ 1, 2, 3 ],
baz => { a => 1 },
quux => 'yadda',
brax => [qw( a b c d )],
],
expect =>
qr|^The 'brax' parameter \("ARRAY\(0x[a-f0-9]+\)"\) to [\w:]+sub3 was an 'arrayref'.* types: scalar hash|,
},
{
sub => 'sub3',
p => [
foo => 'foobar',
bar => { 1, 2, 3, 4 },
baz => { a => 1 },
quux => 'yadda',
brax => 'a',
],
expect =>
qr|^The 'bar' parameter \("HASH\(0x[a-f0-9]+\)"\) to [\w:]+sub3 was a 'hashref'.* types: arrayref|,
},
# more unusual types
{
sub => 'sub4',
p => [
foo => \$String,
bar => do { local *FH; *FH; },
baz => \*BAZZY,
quux => sub {'a coderef'},
],
expect => q{},
},
{
sub => 'sub4',
p => [
foo => \$String,
bar => \*BARRY,
baz => \*BAZZY,
quux => sub {'a coderef'},
],
expect =>
qr|^The 'bar' parameter \("GLOB\(0x[a-f0-9]+\)"\) to [\w:]+sub4 was a 'globref'.* types: glob|,
},
{
sub => 'sub4',
p => [
foo => \$String,
bar => *GLOBBY,
baz => do { local *FH; *FH; },
quux => sub {'a coderef'},
],
expect =>
qr|^The 'baz' parameter \((?:"\*[\w:]+FH"\|GLOB)\) to [\w:]+sub4 was a 'glob'.* types: globref|,
},
{
sub => 'sub4',
p => [
foo => $String,
bar => do { local *FH; *FH; },
baz => \*BAZZY,
quux => sub {'a coderef'},
],
expect =>
qr|^The 'foo' parameter \("foo"\) to [\w:]+sub4 was a 'scalar'.* types: scalarref|,
},
{
sub => 'sub4',
p => [
foo => \$String,
bar => do { local *FH; *FH; },
baz => \*BAZZY,
quux => \*CODEREF,
],
expect =>
qr|^The 'quux' parameter \("GLOB\(0x[a-f0-9]+\)"\) to [\w:]+sub4 was a 'globref'.* types: coderef|,
},
# test HANDLE type
{
sub => 'sub4a',
p => [ foo => \*HANDLE ],
expect => q{},
},
{
sub => 'sub4a',
p => [ foo => *HANDLE ],
expect => q{},
},
{
sub => 'sub4a',
p => [ foo => ['not a handle'] ],
expect =>
qr|^The 'foo' parameter \("ARRAY\(0x[a-f0-9]+\)"\) to [\w:]+sub4a was an 'arrayref'.* types: glob globref|,
},
# test BOOLEAN type
{
sub => 'sub4b',
p => [ foo => undef ],
expect => q{},
},
{
sub => 'sub4b',
p => [ foo => 124125 ],
expect => q{},
},
# isa
{
sub => 'sub5',
p => [ foo => $Foo ],
expect => q{},
}, {
sub => 'sub5',
p => [ foo => $Bar ],
expect => q{},
}, {
sub => 'sub5',
p => [ foo => $Baz ],
expect => q{},
},
{
sub => 'sub6',
p => [ foo => $Foo ],
expect =>
qr|^The 'foo' parameter \("Foo=SCALAR\(0x[a-f0-9]+\)"\) to [\w:]+sub6 was not a 'Bar'|,
}, {
sub => 'sub6',
p => [ foo => $Bar ],
expect => q{},
}, {
sub => 'sub7',
p => [ foo => $Baz ],
expect => q{},
},
{
sub => 'sub7',
p => [ foo => $Foo ],
expect =>
qr|^The 'foo' parameter \("Foo=SCALAR\(0x[a-f0-9]+\)"\) to [\w:]+sub7 was not a 'Baz'|,
}, {
sub => 'sub7',
p => [ foo => $Bar ],
expect =>
qr|^The 'foo' parameter \("Bar=SCALAR\(0x[a-f0-9]+\)"\) to [\w:]+sub7 was not a 'Baz'|,
}, {
sub => 'sub7',
p => [ foo => $Baz ],
expect => q{},
},
{
sub => 'sub8',
p => [ foo => $Foo ],
expect =>
qr|^The 'foo' parameter \("Foo=SCALAR\(0x[a-f0-9]+\)"\) to [\w:]+sub8 was not a 'Yadda'|,
},
{
sub => 'sub8',
p => [ foo => $Quux ],
expect => q{},
},
# can
{
sub => 'sub9',
p => [ foo => $Foo ],
expect => q{},
}, {
sub => 'sub9',
p => [ foo => $Quux ],
expect => q{},
},
{
sub => 'sub9a',
p => [ foo => $Foo ],
expect =>
qr|^The 'foo' parameter \("Foo=SCALAR\(0x[a-f0-9]+\)"\) to [\w:]+sub9a does not have the method: 'barify'|,
}, {
sub => 'sub9a',
p => [ foo => $Bar ],
expect => q{},
},
{
sub => 'sub9b',
p => [ foo => $Baz ],
expect =>
qr|^The 'foo' parameter \("Baz=SCALAR\(0x[a-f0-9]+\)"\) to [\w:]+sub9b does not have the method: 'yaddaify'|,
}, {
sub => 'sub9b',
p => [ foo => $Quux ],
expect =>
qr|^The 'foo' parameter \("Quux=SCALAR\(0x[a-f0-9]+\)"\) to [\w:]+sub9b does not have the method: 'barify'|,
},
{
sub => 'sub9c',
p => [ foo => $Bar ],
expect =>
qr|^The 'foo' parameter \("Bar=SCALAR\(0x[a-f0-9]+\)"\) to [\w:]+sub9c does not have the method: 'yaddaify'|,
},
{
sub => 'sub9c',
p => [ foo => $Quux ],
expect => q{},
},
# callbacks
{
sub => 'sub10',
p => [ foo => 1 ],
expect => q{},
},
{
sub => 'sub10',
p => [ foo => 19 ],
expect => q{},
},
{
sub => 'sub10',
p => [ foo => 20 ],
expect =>
qr|^The 'foo' parameter \("20"\) to [\w:]+sub10 did not pass the 'less than 20' callback|,
},
{
sub => 'sub11',
p => [ foo => 1 ],
expect => q{},
}, {
sub => 'sub11',
p => [ foo => 20 ],
expect =>
qr|^The 'foo' parameter \("20"\) to [\w:]+sub11 did not pass the 'less than 20' callback|,
},
{
sub => 'sub11',
p => [ foo => 0 ],
expect =>
qr|^The 'foo' parameter \("0"\) to [\w:]+sub11 did not pass the 'more than 0' callback|,
},
# mix n' match
{
sub => 'sub12',
p => [ foo => 1 ],
expect =>
qr|^The 'foo' parameter \("1"\) to [\w:]+sub12 was a 'scalar'.* types: arrayref|,
},
{
sub => 'sub12',
p => [ foo => [ 1, 2, 3 ] ],
expect =>
qr|^The 'foo' parameter \("ARRAY\(0x[a-f0-9]+\)"\) to [\w:]+sub12 did not pass the '5 elements' callback|,
},
{
sub => 'sub12',
p => [ foo => [ 1, 2, 3, 4, 5 ] ],
expect => q{},
},
# positional - 1
{
sub => 'sub13',
p => ['a'],
expect => qr|^1 parameter was passed to .* but 2 were expected|,
},
{
sub => 'sub13',
p => [ 'a', [ 1, 2, 3 ] ],
expect =>
qr|^Parameter #2 \("ARRAY\(0x[a-f0-9]+\)"\) to .* did not pass the '5 elements' callback|,
},
# positional - 2
{
sub => 'sub14',
p => [ 'a', [ 1, 2, 3 ], $Foo ],
expect =>
qr|^Parameter #3 \("Foo=SCALAR\(0x[a-f0-9]+\)"\) to .* was not a 'Bar'|,
},
{
sub => 'sub14',
p => [ 'a', [ 1, 2, 3 ], $Bar ],
expect => q{},
},
# hashref named params
{
sub => 'sub15',
p => [ { foo => 1, bar => { a => 1 } } ],
expect =>
qr|^The 'bar' parameter \("HASH\(0x[a-f0-9]+\)"\) to .* was a 'hashref'.* types: arrayref|,
},
{
sub => 'sub15',
p => [ { foo => 1 } ],
expect => qr|^Mandatory parameter 'bar' missing|,
},
# positional - 3
{
sub => 'sub16',
p => [ 1, 2, 3 ],
expect => qr|^3 parameters were passed .* but 1 - 2 were expected|,
},
{
sub => 'sub16',
p => [ 1, 2 ],
expect => q{},
},
{
sub => 'sub16',
p => [1],
expect => q{},
},
{
sub => 'sub16',
p => [],
expect => qr|^0 parameters were passed .* but 1 - 2 were expected|,
},
# positional - 4
{
sub => 'sub17',
p => [ 1, 2, 3 ],
expect => qr|^3 parameters were passed .* but 1 - 2 were expected|,
},
{
sub => 'sub17',
p => [ 1, 2 ],
expect => q{},
},
{
sub => 'sub17',
p => [1],
expect => q{},
},
{
sub => 'sub17',
p => [],
expect => qr|^0 parameters were passed .* but 1 - 2 were expected|,
},
# positional - too few arguments supplied
{
sub => 'sub17a',
p => [],
expect => qr|^0 parameters were passed .* but 3 - 4 were expected|,
},
{
sub => 'sub17a',
p => [ 1, 2 ],
expect => qr|^2 parameters were passed .* but 3 - 4 were expected|,
},
{
sub => 'sub17b',
p => [],
expect => qr|^0 parameters were passed .* but 3 - 4 were expected|,
},
{
sub => 'sub17b',
p => [ 42, 2 ],
expect => qr|^2 parameters were passed .* but 3 - 4 were expected|,
},
# validation options - ignore case
{
sub => 'Foo::sub18',
p => [ FOO => 1 ],
options => { ignore_case => 1 },
expect => q{},
},
{
sub => 'sub18',
p => [ FOO => 1 ],
expect => qr|^The following parameter .* FOO|,
},
# validation options - strip leading
{
sub => 'Foo::sub18',
p => [ -foo => 1 ],
options => { strip_leading => '-' },
expect => q{},
},
{
sub => 'sub18',
p => [ -foo => 1 ],
expect => qr|^The following parameter .* -foo|,
},
# validation options - allow extra
{
sub => 'Foo::sub18',
p => [ foo => 1, bar => 1 ],
options => { allow_extra => 1 },
expect => q{},
return => { foo => 1, bar => 1 },
},
{
sub => 'sub18',
p => [ foo => 1, bar => 1 ],
expect => qr|^The following parameter .* bar|,
},
{
sub => 'Foo::sub19',
p => [ 1, 2 ],
options => { allow_extra => 1 },
expect => q{},
return => [ 1, 2 ],
},
{
sub => 'sub19',
p => [ 1, 2 ],
expect => qr|^2 parameters were passed .* but 1.*|,
},
# validation options - on fail
{
sub => 'Foo::sub18',
p => [ bar => 1 ],
options => {
on_fail => sub { die "ERROR WAS: $_[0]" }
},
expect => qr|^ERROR WAS: The following parameter .* bar|,
},
{
sub => 'sub18',
p => [ bar => 1 ],
expect => qr|^The following parameter .* bar|,
},
{
sub => 'sub20',
p => [ foo => undef ],
expect => qr|^The 'foo' parameter \(undef\) to .* was an 'undef'.*|,
},
{
sub => 'sub21',
p => [ foo => undef ],
expect => q{},
},
{
sub => 'sub22',
p => [ foo => [1] ],
expect =>
qr|^The 'foo' parameter \("ARRAY\(0x[a-f0-9]+\)"\) to .* was an 'arrayref'.*|,
},
{
sub => 'sub22',
p => [ foo => bless [1], 'object' ],
expect => q{},
},
{
sub => 'sub22a',
p => [],
expect => q{},
}, {
sub => 'sub22a',
p => [ foo => [1] ],
expect =>
qr|^The 'foo' parameter \("ARRAY\(0x[a-f0-9]+\)"\) to .* was an 'arrayref'.*|,
}, {
sub => 'sub22a',
p => [ foo => bless [1], 'object' ],
expect => q{},
},
{
sub => 'sub23',
p => ['1 element'],
expect => q{},
},
{
sub => 'sub24',
p => [],
expect => q{},
}, {
sub => 'sub24',
p => ['1 element'],
expect => qr|^Parameter #1 \("1 element"\) to .* was a 'scalar'.*|,
},
{
sub => 'sub24',
p => [ bless [1], 'object' ],
expect => q{},
},
{
sub => 'sub25',
p => [1],
expect => qr|^Odd number|,
always_errors => 1,
},
# optional glob
{
sub => 'sub26',
p => [
foo => 1, bar => do { local *BAR; *BAR }
],
expect => q{},
},
);
sub run_tests {
my $count = scalar @Tests;
$count++ for grep { $_->{return} } @Tests;
for my $test (@Tests) {
if ( $test->{options} ) {
package Foo;
validation_options( %{ $test->{options} } );
}
my $sub = $test->{sub};
my @r = eval "$sub( \@{ \$test->{p} } )";
if (
$test->{expect}
&& ( $test->{always_errors}
|| !$ENV{PERL_NO_VALIDATION} )
) {
like( $@, $test->{expect}, "expect error with $sub" );
}
else {
is( $@, q{}, "no error with $sub" );
}
next unless $test->{return};
if ( eval { %{ $test->{return} } } ) {
my %r = @r;
is_deeply(
\%r, $test->{return},
"check return value for $sub - hash"
);
}
else {
is_deeply(
\@r, $test->{return},
"check return value for $sub - array"
);
}
}
done_testing();
}
sub sub1 {
validate( @_, { foo => 1, bar => 1 } );
}
sub sub2 {
validate( @_, { foo => 1, bar => 1, baz => 0 } );
}
sub sub2a {
validate( @_, { foo => 1, bar => { optional => 1 } } );
}
sub sub3 {
validate(
@_, {
foo => { type => SCALAR },
bar =>
{ type => ARRAYREF },
baz =>
{ type => HASHREF },
quux =>
{ type => SCALAR | ARRAYREF },
brax =>
{ type => SCALAR | HASHREF },
}
);
}
sub sub4 {
validate(
@_, {
foo => { type => SCALARREF },
bar =>
{ type => GLOB },
baz =>
{ type => GLOBREF },
quux =>
{ type => CODEREF },
}
);
}
sub sub4a {
validate( @_, { foo => { type => HANDLE } } );
}
sub sub4b {
validate( @_, { foo => { type => BOOLEAN } } );
}
sub sub5 {
validate( @_, { foo => { isa => 'Foo' } } );
}
sub sub6 {
validate( @_, { foo => { isa => 'Bar' } } );
}
sub sub7 {
validate( @_, { foo => { isa => 'Baz' } } );
}
sub sub8 {
validate( @_, { foo => { isa => [ 'Foo', 'Yadda' ] } } );
}
sub sub9 {
validate( @_, { foo => { can => 'fooify' } } );
}
sub sub9a {
validate( @_, { foo => { can => [ 'fooify', 'barify' ] } } );
}
sub sub9b {
validate( @_, { foo => { can => [ 'barify', 'yaddaify' ] } } );
}
sub sub9c {
validate( @_, { foo => { can => [ 'fooify', 'yaddaify' ] } } );
}
sub sub10 {
validate(
@_, {
foo => {
callbacks => {
'less than 20' => sub { shift() < 20 }
}
}
}
);
}
sub sub11 {
validate(
@_, {
foo => {
callbacks => {
'less than 20' => sub { shift() < 20 },
'more than 0' => sub { shift() > 0 },
}
}
}
);
}
sub sub12 {
validate(
@_, {
foo => {
type => ARRAYREF,
callbacks => {
'5 elements' => sub { @{ shift() } == 5 }
}
}
}
);
}
sub sub13 {
validate_pos(
@_,
{ type => SCALAR },
{
type => ARRAYREF,
callbacks => {
'5 elements' => sub { @{ shift() } == 5 }
}
}
);
}
sub sub14 {
validate_pos(
@_,
{ type => SCALAR },
{ type => ARRAYREF },
{ isa => 'Bar' },
);
}
sub sub15 {
validate(
@_, {
foo => 1,
bar => { type => ARRAYREF }
}
);
}
sub sub16 {
validate_pos( @_, 1, 0 );
}
sub sub17 {
validate_pos( @_, { type => SCALAR }, { type => SCALAR, optional => 1 } );
}
{
package Foo;
use Params::Validate;
sub sub18 {
validate( @_, { foo => 1 } );
}
sub sub19 {
validate_pos( @_, 1 );
}
}
sub sub17a {
validate_pos( @_, 1, 1, 1, 0 );
}
sub sub17b {
validate_pos(
@_, {
callbacks => {
'less than 43' => sub { shift() < 43 }
}
},
{ type => SCALAR },
1,
{ optional => 1 }
);
}
sub sub18 {
validate( @_, { foo => 1 } );
}
sub sub19 {
validate_pos( @_, 1 );
}
sub sub20 {
validate( @_, { foo => { type => SCALAR } } );
}
sub sub21 {
validate( @_, { foo => { type => UNDEF | SCALAR } } );
}
sub sub22 {
validate( @_, { foo => { type => OBJECT } } );
}
sub sub22a {
validate( @_, { foo => { type => OBJECT, optional => 1 } } );
}
sub sub23 {
validate_pos( @_, 1 );
}
sub sub24 {
validate_pos( @_, { type => OBJECT, optional => 1 } );
}
sub sub25 {
validate( @_, { foo => 1 } );
}
sub sub26 {
validate(
@_, {
foo => { type => SCALAR },
bar =>
{ type => HANDLE, optional => 1 },
},
);
}
package Foo;
use Params::Validate qw(:all);
sub fooify {1}
package Bar;
@Bar::ISA = ('Foo');
sub barify {1}
package Baz;
@Baz::ISA = ('Bar');
sub bazify {1}
package Yadda;
sub yaddaify {1}
package Quux;
@Quux::ISA = ( 'Foo', 'Yadda' );
sub quuxify {1}
1;