From: Lukas Mai Date: Wed, 7 Aug 2013 05:17:28 +0000 (+0200) Subject: actually use documented defaults for custom keywords X-Git-Tag: v1.0201~3^2~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=11305599a59b5a00d111f396f2b651577a90b80a;p=p5sagit%2FFunction-Parameters.git actually use documented defaults for custom keywords --- diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm index 8720269..701046f 100644 --- a/lib/Function/Parameters.pm +++ b/lib/Function/Parameters.pm @@ -57,6 +57,11 @@ sub _reify_type_default { Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_[0]) } +sub _delete_default { + my ($href, $key, $default) = @_; + exists $href->{$key} ? delete $href->{$key} : $default +} + my @bare_arms = qw(function method); my %type_map = ( function => { @@ -148,16 +153,12 @@ sub import { $clean{attrs} = join ' ', map delete $type{$_} || (), qw(attributes attrs); _assert_valid_attributes $clean{attrs} if $clean{attrs}; - $clean{default_arguments} = - exists $type{default_arguments} - ? !!delete $type{default_arguments} - : 1 - ; + $clean{default_arguments} = _delete_default \%type, 'default_arguments', 1; + $clean{named_parameters} = _delete_default \%type, 'named_parameters', 1; + $clean{types} = _delete_default \%type, 'types', 1; - $clean{check_argument_count} = !!delete $type{check_argument_count}; - $clean{invocant} = !!delete $type{invocant}; - $clean{named_parameters} = !!delete $type{named_parameters}; - $clean{types} = !!delete $type{types}; + $clean{check_argument_count} = _delete_default \%type, 'check_argument_count', 0; + $clean{invocant} = _delete_default \%type, 'invocant', 0; if (my $rt = delete $type{reify_type}) { ref $rt eq 'CODE' or confess qq{"$rt" doesn't look like a type reifier}; diff --git a/t/types_custom.t b/t/types_custom.t index df5c028..02e46fc 100644 --- a/t/types_custom.t +++ b/t/types_custom.t @@ -2,10 +2,13 @@ use warnings FATAL => 'all'; use strict; -use Test::More tests => 4; +use Test::More tests => 8; use Test::Fatal; use Function::Parameters qw(:strict); +use Function::Parameters { + def => { check_argument_count => 1 }, +}; { package MyTC; @@ -47,3 +50,12 @@ is foo(42, "hello"), "42/hello"; like exception { foo 41, "hello" }, qr{\bValidation failed for constraint 'even number' with value '41'}; like exception { foo 42, "1234567890~" }, qr{\bValidation failed for constraint 'short string' with value '1234567890~'}; like exception { foo 41, "1234567890~" }, qr{\bValidation failed for constraint 'even number' with value '41'}; + +def foo2((TEvenNum) $x, (TShortStr) $y) { + "$x/$y" +} + +is foo2(42, "hello"), "42/hello"; +like exception { foo2 41, "hello" }, qr{\bValidation failed for constraint 'even number' with value '41'}; +like exception { foo2 42, "1234567890~" }, qr{\bValidation failed for constraint 'short string' with value '1234567890~'}; +like exception { foo2 41, "1234567890~" }, qr{\bValidation failed for constraint 'even number' with value '41'}; diff --git a/t/types_custom_2.t b/t/types_custom_2.t index f22ae0e..fa8ec06 100644 --- a/t/types_custom_2.t +++ b/t/types_custom_2.t @@ -45,7 +45,6 @@ use Function::Parameters do { +{ fun => { check_argument_count => 1, - types => 1, reify_type => sub { $Types{ $_[0] } || $Types{Any} }, }, } diff --git a/t/types_moose_3.t b/t/types_moose_3.t new file mode 100644 index 0000000..8251c87 --- /dev/null +++ b/t/types_moose_3.t @@ -0,0 +1,133 @@ +#!perl +use warnings FATAL => 'all'; +use strict; + +use Test::More + eval { require Moose; 1 } + ? (tests => 49) + : (skip_all => "Moose required for testing types") +; +use Test::Fatal; + +use Function::Parameters { + def => { check_argument_count => 1 }, +}; + +def foo(Int $n, CodeRef $f, $x) { + $x = $f->($x) for 1 .. $n; + $x +} + +is foo(0, def {}, undef), undef; +is foo(0, def {}, "o hai"), "o hai"; +is foo(3, def ($x) { "($x)" }, 1.5), "(((1.5)))"; +is foo(3, def (Str $x) { "($x)" }, 1.5), "(((1.5)))"; + +{ + my $info = Function::Parameters::info \&foo; + is $info->invocant, undef; + is $info->slurpy, undef; + is $info->positional_optional, 0; + is $info->named_required, 0; + is $info->named_optional, 0; + my @req = $info->positional_required; + is @req, 3; + is $req[0]->name, '$n'; + ok $req[0]->type->equals('Int'); + is $req[1]->name, '$f'; + ok $req[1]->type->equals('CodeRef'); + is $req[2]->name, '$x'; + is $req[2]->type, undef; +} + +like exception { foo("ermagerd", def {}, undef) }, qr/\bparameter 1.+\$n\b.+\bValidation failed\b.+\bInt\b.+ermagerd/; +like exception { foo(0, {}, undef) }, qr/\bparameter 2.+\$f\b.+\bValidation failed\b.+\bCodeRef\b/; + +def bar(((Function::Parameters::info(\&foo)->positional_required)[0]->type) $whoa) { $whoa * 2 } + +is bar(21), 42; +{ + my $info = Function::Parameters::info \&bar; + is $info->invocant, undef; + is $info->slurpy, undef; + is $info->positional_optional, 0; + is $info->named_required, 0; + is $info->named_optional, 0; + my @req = $info->positional_required; + is @req, 1; + is $req[0]->name, '$whoa'; + ok $req[0]->type->equals('Int'); +} + +{ + my $info = Function::Parameters::info(def ( ArrayRef [ Int | CodeRef ]@nom) {}); + is $info->invocant, undef; + is $info->positional_required, 0; + is $info->positional_optional, 0; + is $info->named_required, 0; + is $info->named_optional, 0; + my $slurpy = $info->slurpy; + is $slurpy->name, '@nom'; + ok $slurpy->type->equals(Moose::Util::TypeConstraints::find_or_parse_type_constraint('ArrayRef[Int|CodeRef]')); +} + +{ + my $phase = 'runtime'; + BEGIN { $phase = 'A'; } + def + baz + ( + ( + is + ( + $phase + ++ + , + 'A' + ) + , + 'Int' + ) + : + $marco + , + ( + is + ( + $phase + ++ + , + 'B' + ) + , + q + $ArrayRef[Str]$ + ) + : + $polo + ) + { + [ + $marco + , + $polo + ] + } + BEGIN { is $phase, 'C'; } + is $phase, 'runtime'; + + is_deeply baz(polo => [qw(foo bar baz)], marco => 11), [11, [qw(foo bar baz)]]; + + my $info = Function::Parameters::info \&baz; + is $info->invocant, undef; + is $info->slurpy, undef; + is $info->positional_required, 0; + is $info->positional_optional, 0; + is $info->named_optional, 0; + my @req = $info->named_required; + is @req, 2; + is $req[0]->name, '$marco'; + ok $req[0]->type->equals('Int'); + is $req[1]->name, '$polo'; + ok $req[1]->type->equals('ArrayRef[Str]'); +}