actually use documented defaults for custom keywords

diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm
index 8720269..701046f 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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]');
+}