#!/usr/bin/perl
use strict;
use warnings;
use Benchmark qw(cmpthese);
use lib qw(/home/dams/scratchpad/Params-Check-0.26/lib);
use Params::Check;
use Params::Check2;
my %tests =
(
real_life => {
count => 10000,
code_in_func => 'my $foo1; my $foo2; my $foo3',
template => q({
arg1 => { defined => 1, strict_type => 1, default => '' },
arg2 => { default => 'bar', store => \$foo1 },
arg3 => { default => 'mod', store => \$foo2 },
arg4 => { defined => 1, strict_type => 1, default => [], store => \$foo3 },
arg5 => { default => {}, strict_type => 1 },
arg6 => { default => 'a', allow => [ qw(b a c d) ], strict_type => 1},
}),
params => [q({
arg1 => 'foo',
arg2 => 'moz',
arg4 => [ 'answer', 42 ],
arg5 => { answer => 42 },
arg6 => 'c',
})],
},
real_life2 => {
count => 10000,
code => '$Params::Check::PRESERVE_CASE= 0; $Params::Check::ALLOW_UNKNOWN = 1; $Params::Check::SANITY_CHECK_TEMPLATE = 0; ',
template => q({
arg1 => { defined => 1, strict_type => 1, default => ''},
arg2 => { default => 'bar'},
arg3 => { default => 'mod'},
arg4 => { defined => 1, strict_type => 1, default => ''},
arg5 => { default => 'bar'},
arg6 => { default => 'mod'},
arg7 => { defined => 1, strict_type => 1, default => ''},
arg8 => { default => 'bar'},
arg9 => { default => 'mod'},
}),
params => [q({
arg1 => 'foo',
arg2 => 'moz',
arg3 => 'answer',
arg4 => 'foo',
arg5 => 'moz',
arg6 => 'answer',
arg7 => 'foo',
arg8 => 'moz',
arg9 => 'answer',
})],
},
r1 => {
count => 10000,
template => q({
arg1 => { defined => 1, strict_type => 1, default => ''},
arg2 => { default => 'bar'},
arg3 => { default => 'mod'},
arg4 => { defined => 1, strict_type => 1, default => ''},
arg5 => { default => 'bar'},
arg6 => { default => 'mod'},
arg7 => { defined => 1, strict_type => 1, default => ''},
arg8 => { default => 'bar'},
arg9 => { default => 'mod'},
}),
params => [q({
arg1 => 'foo',
arg2 => 'moz',
arg3 => 'answer',
arg4 => 'foo',
arg5 => 'moz',
arg6 => 'answer',
arg7 => 'foo',
arg8 => 'moz',
arg9 => 'answer',
})],
},
r2 => {
count => 10000,
code => '$Params::Check::SANITY_CHECK_TEMPLATE = 0; ',
template => q({
arg1 => { defined => 1, strict_type => 1, default => ''},
arg2 => { default => 'bar'},
arg3 => { default => 'mod'},
arg4 => { defined => 1, strict_type => 1, default => ''},
arg5 => { default => 'bar'},
arg6 => { default => 'mod'},
arg7 => { defined => 1, strict_type => 1, default => ''},
arg8 => { default => 'bar'},
arg9 => { default => 'mod'},
}),
params => [q({
arg1 => 'foo',
arg2 => 'moz',
arg3 => 'answer',
arg4 => 'foo',
arg5 => 'moz',
arg6 => 'answer',
arg7 => 'foo',
arg8 => 'moz',
arg9 => 'answer',
})],
},
simple => {
count => 30000,
template => '{
arg1 => {},
}',
params => ['{
arg1 => 1,
}'],
},
default => {
count => 30000,
template => '{
foo => { default => 1 }
}',
params => [
'{}',
'{ foo => 2}',
'{ FOO => 2}',
'{ -foo => 2}',
],
},
no_override => {
count => 10000,
template => '{
foo => { no_override => 1, default => 42 }
}',
params => [
'{ foo => 13 }',
],
},
required => {
count => 20000,
template => '{
foo => { required => 1 }
}',
params => [
'{ foo => 42 }',
'{ }',
],
},
invalid_key_tests => {
count => 10000,
template => '{
foo => { allow => sub { 0 } }
}',
params => [
'{ foo => 1 }',
'{ foo => "foo" }',
'{ foo => [] }',
'{ foo => bless({},__PACKAGE__) }',
],
},
invalid_store => {
count => 50000,
template => q({
foo => { store => '' }
}),
params => [
'{ }',
],
},
edge_case => {
count => 30000,
template => q({
foo => { default => '' }
}),
params => [
'{ }',
],
},
big_template => {
count => 10000,
template => q({
firstname => { required => 1, defined => 1 },
lastname => { required => 1, store => \$lastname },
gender => { required => 1,
allow => [qr/M/i, qr/F/i],
},
married => { allow => [0,1] },
age => { default => 21,
allow => qr/^\d+$/,
},
id_list => { default => [],
strict_type => 1
},
phone => { allow => sub { 1 if +shift } },
bureau => { default => 'NSA',
no_override => 1
},
}),
params => [
q({
firstname => 'joe',
lastname => 'jackson',
gender => 'M',
married => 1,
age => 21,
id_list => [1..3],
phone => '555-8844',
}),
],
},
preserver_case1 => {
count => 20000,
code => '$Params::Check::PRESERVE_CASE = 1',
template => q({
Foo => { default => 1 }
}),
params => [
'{ Foo => 42 }',
],
},
preserver_case2 => {
count => 20000,
code => '$Params::Check::PRESERVE_CASE = 0',
template => q({
Foo => { default => 1 }
}),
params => [
'{ Foo => 42 }',
],
},
unknown1 => {
count => 20000,
template => q({ }),
params => [
'{ foo => 42 }',
],
},
unknown2 => {
count => 20000,
code => '$Params::Check::ALLOW_UNKNOWN = 1',
template => q({ }),
params => [
'{ foo => 42 }',
],
},
store1 => {
count => 20000,
code => '$Params::Check::NO_DUPLICATES = 1; my $foo;',
template => q({ foo => { store => \$foo } }),
params => [
'{ foo => 42 }',
],
},
store2 => {
count => 20000,
code => '$Params::Check::NO_DUPLICATES = 0; my $foo;',
template => q({ foo => { store => \$foo } }),
params => [
'{ foo => 42 }',
],
},
strict1 => {
count => 20000,
code => '$Params::Check::STRICT_TYPE = 0',
template => q({ foo => { strict_type => 1, default => [] } }),
params => [
'{ foo => [] }',
'{ foo => {} }',
],
},
strict2 => {
count => 20000,
code => '$Params::Check::STRICT_TYPE = 1',
template => q({ foo => { default => [] } }),
params => [
'{ foo => [] }',
'{ foo => {} }',
],
},
define1 => {
count => 20000,
code => '$Params::Check::ONLY_ALLOW_DEFINED = 0',
template => q({ foo => { defined => 1, default => 1 } }),
params => [
'{ foo => 42 }',
'{ foo => undef }',
],
},
define2 => {
count => 20000,
code => '$Params::Check::ONLY_ALLOW_DEFINED = 1',
template => q({ foo => { default => 1 } }),
params => [
'{ foo => 42 }',
'{ foo => undef }',
],
},
subs1 => {
count => 20000,
template => q({ foo => { allow => sub { [] } } }),
params => [
'{ foo => [] }',
],
},
subs2 => {
count => 20000,
template => q({ foo => { allow => sub { {} } } }),
params => [
'{ foo => {} }',
],
},
subs3 => {
count => 20000,
template => q({ foo => { allow => sub { 1 } } }),
params => [
'{ foo => 1 }',
],
},
);
#my @keep = qw(store1 store2);
#my @keep = qw(r1 r2);
#my @keep = qw(real_life real_life2);
#if (@keep) {
# my %f;
# @f{@keep} = @tests{@keep};
# %tests = %f;
#}
while (my ($name, $data) = each(%tests)) {
my ($count, $template, $params, $code, $code_in_func) = @{$data}{qw(count template params code code_in_func)};
local $Params::Check::VERBOSE;
local $Params::Check::NO_DUPLICATES;
local $Params::Check::STRIP_LEADING_DASHES;
local $Params::Check::STRICT_TYPE;
local $Params::Check::ALLOW_UNKNOWN;
local $Params::Check::PRESERVE_CASE;
local $Params::Check::ONLY_ALLOW_DEFINED;
local $Params::Check::SANITY_CHECK_TEMPLATE;
local $Params::Check::WARNINGS_FATAL;
local $Params::Check::CALLER_DEPTH;
local $Params::Check2::VERBOSE;
local $Params::Check2::NO_DUPLICATES;
local $Params::Check2::STRIP_LEADING_DASHES;
local $Params::Check2::STRICT_TYPE;
local $Params::Check2::ALLOW_UNKNOWN;
local $Params::Check2::PRESERVE_CASE;
local $Params::Check2::ONLY_ALLOW_DEFINED;
local $Params::Check2::SANITY_CHECK_TEMPLATE;
local $Params::Check2::WARNINGS_FATAL;
local $Params::Check2::CALLER_DEPTH;
$code_in_func ||= '';
$code ||= '';
my $code_original = $code;
my $code_new = $code;
my $code_new3 = $code;
$code_new =~ s/Check/Check2/g;
$code_new3 =~ s/Check/Check3/g;
print "*** $name\n";
my $i = 0;
foreach (@$params) {
local $SIG{__WARN__} = sub {};
cmpthese($count, {
orig => qq( $code_original; foo($_); sub foo { $code_in_func; Params::Check::check($template, \$_[0]) } ),
new => qq( $code_new; foo($_); sub foo { $code_in_func; Params::Check2::check($template, \$_[0]) } ),
});
}
print "\n";
}
