use strict;
use Params::Validate qw(:all);
print "1..97\n";
$| = 1;
sub run_tests
{
{
eval { sub1( foo => 'a', bar => 'b' ) };
check();
eval { sub1( foo => 'a' ) };
check();
eval { sub1() };
check();
eval { sub1( foo => 'a', bar => 'b', baz => 'c' ) };
check();
eval { sub2( foo => 'a', bar => 'b', baz => 'c' ) };
check();
eval { sub2( foo => 'a', bar => 'b' ) };
check();
eval { sub2a( foo => 'a', bar => 'b' ) };
check();
eval { sub2a( foo => 'a' ) };
check();
}
{
eval { sub3( foo => 'a',
bar => [ 1, 2, 3 ],
baz => { a => 1 },
quux => 'yadda',
brax => { qw( a b c d ) },
) };
check();
eval { sub3( foo => ['a'],
bar => [ 1, 2, 3 ],
baz => { a => 1 },
quux => 'yadda',
brax => { qw( a b c d ) },
) };
check();
eval { sub3( foo => 'foobar',
bar => [ 1, 2, 3 ],
baz => { a => 1 },
quux => 'yadda',
brax => [ qw( a b c d ) ],
) };
check();
eval { sub3( foo => 'foobar',
bar => { 1, 2, 3, 4 },
baz => { a => 1 },
quux => 'yadda',
brax => 'a',
) };
check();
}
{
my $foo = 'foobar';
eval { sub4( foo => \$foo,
bar => do { local *FH; *FH; },
baz => \*BAZZY,
quux => sub { 'a coderef' },
) };
check();
eval { sub4( foo => \$foo,
bar => \*BARRY,
baz => \*BAZZY,
quux => sub { 'a coderef' },
) };
check();
eval { sub4( foo => \$foo,
bar => *GLOBBY,
baz => do { local *FH; *FH; },
quux => sub { 'a coderef' },
) };
check();
eval { sub4( foo => $foo,
bar => do { local *FH; *FH; },
baz => \*BAZZY,
quux => sub { 'a coderef' },
) };
check();
eval { sub4( foo => \$foo,
bar => do { local *FH; *FH; },
baz => \*BAZZY,
quux => \*CODEREF,
) };
check();
eval { sub4a( foo => \*HANDLE) };
check();
eval { sub4a( foo => *HANDLE) };
check();
eval { sub4a( foo => ['not a handle'] ) };
check();
eval { sub4b( foo => undef ) };
check();
eval { sub4b( foo => 124125 ) };
check();
}
{
my ($x, $y, $z, $zz);
my $foo = bless \$x, 'Foo';
my $bar = bless \$y, 'Bar';
my $baz = bless \$z, 'Baz';
my $quux = bless \$zz, 'Quux';
eval { sub5( foo => $foo ) };
check();
eval { sub5( foo => $bar ) };
check();
eval { sub5( foo => $baz ) };
check();
eval { sub6( foo => $foo ) };
check();
eval { sub6( foo => $bar ) };
check();
eval { sub7( foo => $baz ) };
check();
eval { sub7( foo => $foo ) };
check();
eval { sub7( foo => $bar ) };
check();
eval { sub7( foo => $baz ) };
check();
eval { sub8( foo => $foo ) };
check();
eval { sub8( foo => $quux ) };
check();
}
{
my ($x, $y, $z, $zz);
my $foo = bless \$x, 'Foo';
my $bar = bless \$y, 'Bar';
my $baz = bless \$z, 'Baz';
my $quux = bless \$zz, 'Quux';
eval { sub9( foo => $foo ) };
check();
eval { sub9( foo => $quux ) };
check();
eval { sub9a( foo => $foo ) };
check();
eval { sub9a( foo => $bar ) };
check();
eval { sub9b( foo => $baz ) };
check();
eval { sub9b( foo => $quux ) };
check();
eval { sub9c( foo => $bar ) };
check();
eval { sub9c( foo => $quux ) };
check();
}
{
eval { sub10( foo => 1 ) };
check();
eval { sub10( foo => 19 ) };
check();
eval { sub10( foo => 20 ) };
check();
eval { sub11( foo => 1 ) };
check();
eval { sub11( foo => 20 ) };
check();
eval { sub11( foo => 0 ) };
check();
}
{
eval { sub12( foo => 1 ) };
check();
eval { sub12( foo => [ 1, 2, 3 ] ) };
check();
eval { sub12( foo => [ 1, 2, 3, 4, 5 ] ) };
check();
}
{
eval { sub13( 'a' ) };
check();
eval { sub13( 'a', [ 1, 2, 3 ] ) };
check();
}
{
my ($x, $y);
my $foo = bless \$x, 'Foo';
my $bar = bless \$y, 'Bar';
eval { sub14( 'a', [ 1, 2, 3 ], $foo ) };
check();
eval { sub14( 'a', [ 1, 2, 3 ], $bar ) };
check();
}
{
eval { sub15( { foo => 1, bar => { a => 1 } } ) };
check();
eval { sub15( { foo => 1 } ) };
check();
}
{
eval { sub16( 1, 2, 3 ) };
check();
eval { sub16( 1, 2 ) };
check();
eval { sub16( 1 ) };
check();
eval { sub16() };
check();
}
{
eval { sub17( 1, 2, 3 ) };
check();
eval { sub17( 1, 2 ) };
check();
eval { sub17( 1 ) };
check();
eval { sub17() };
check();
}
{
eval { sub17a() };
check();
eval { sub17a(1, 2) };
check();
eval { sub17b() };
check();
eval { sub17b(42, 2) };
check();
}
{
{
package Foo;
Params::Validate::validation_options( ignore_case => 1 );
}
eval { Foo::sub18( FOO => 1 ) };
check();
eval { sub18( FOO => 1 ) };
check();
}
{
{
package Foo;
validation_options( strip_leading => '-' );
}
eval { Foo::sub18( -foo => 1 ) };
check();
eval { sub18( -foo => 1 ) };
check();
}
{
{
package Foo;
validation_options( allow_extra => 1 );
}
my %ret = eval { Foo::sub18( foo => 1, bar => 1 ) };
check();
ok($ret{foo} == 1);
ok($ret{bar} == 1);
eval { sub18( foo => 1, bar => 1 ) };
check();
my @ret = eval { Foo::sub19( 1, 2 ) };
check();
ok($ret[0] == 1);
ok($ret[1] == 2);
eval { sub19( 1, 2 ) };
check();
validation_options( strip_leading => '-' );
eval { Foo::sub18( -foo => 1 ) };
check();
}
validation_options();
{
{
package Foo;
validation_options( on_fail => sub { die "ERROR WAS: $_[0]" } );
}
eval { Foo::sub18( bar => 1 ) };
check();
eval { sub18( bar => 1 ) };
check();
}
eval { sub20( foo => undef ) };
check();
eval { sub21( foo => undef ) };
check();
eval { sub22( foo => [1] ) };
check();
eval { sub22( foo => bless [1], 'object' ) };
check();
eval { sub22a( ) };
check();
eval { sub22a( foo => [1] ) };
check();
eval { sub22a( foo => bless [1], 'object' ) };
check();
eval { sub23( '1 element' ) };
check();
eval { sub24( ) };
check();
eval { sub24( '1 element' ) };
check();
eval { sub24( bless [1], 'object' ) };
check();
eval { sub25( 1 ) };
check();
eval { sub26( foo => 1 ) };
check();
{
my $fh = do { local *BAR; *BAR };
eval { sub26( foo => 1, bar => $fh ) };
check();
}
}
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 },
},
);
}
{
my $x = 0;
sub check
{
my $expect = $expect[$x++];
my $line = (caller(0))[2];
$expect ?
ok( ( $@ =~ /$expect/ ? 1 : 0 ),
$@ ?
"$@ did not match:\n$expect" :
"no error when error was expected ($expect) - line $line" ) :
ok( ! $@, $@ );
}
}
sub ok
{
my $ok = !!shift;
use vars qw($TESTNUM);
$TESTNUM++;
print "not "x!$ok, "ok $TESTNUM\n";
print "@_\n" if !$ok;
}
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;