Merge branch 'named-params'

Conflicts:
	MANIFEST

diff --git a/MANIFEST b/MANIFEST
index 2b619fe..ede94af 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -55,6 +55,11 @@ t/foreign/MooseX-Method-Signatures/precedence.t
 t/foreign/MooseX-Method-Signatures/sigs-optional.t
 t/foreign/MooseX-Method-Signatures/too_many_args.t
 t/foreign/MooseX-Method-Signatures/undef_method_arg.t
+t/foreign/signatures/anon.t
+t/foreign/signatures/basic.t
+t/foreign/signatures/eval.t
+t/foreign/signatures/proto.t
+t/foreign/signatures/weird.t
 t/imports.t
 t/invocant.t
 t/lexical.t

diff --git a/Parameters.xs b/Parameters.xs
index d27c82c..286e79d 100644 (file)
--- a/Parameters.xs
+++ b/Parameters.xs
@@ -930,6 +930,10 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
                        my_check_prototype(aTHX_ declarator, proto);
                        lex_read_space(0);
                        c = lex_peek_unichar(0);
+                       if (!(c == ':' || c == '{')) {
+                               lex_stuff_pvs(":", 0);
+                               c = ':';
+                       }
                }
        }
 

diff --git a/t/foreign/signatures/anon.t b/t/foreign/signatures/anon.t
new file mode 100644 (file)
index 0000000..8e5d995
--- /dev/null
+++ b/t/foreign/signatures/anon.t
@@ -0,0 +1,10 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More tests => 1;
+
+use Function::Parameters;
+
+my $foo = fun ($bar, $baz) { return "${bar}-${baz}" };
+
+is($foo->(qw/bar baz/), 'bar-baz');

diff --git a/t/foreign/signatures/basic.t b/t/foreign/signatures/basic.t
new file mode 100644 (file)
index 0000000..033f640
--- /dev/null
+++ b/t/foreign/signatures/basic.t
@@ -0,0 +1,32 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More tests => 5;
+
+use Function::Parameters;
+
+fun foo ($bar) { $bar }
+
+fun korv ($wurst, $_unused, $birne) {
+    return "${wurst}-${birne}";
+}
+
+fun array ($scalar, @array) {
+    return $scalar + @array;
+}
+
+fun hash (%hash) {
+    return keys %hash;
+}
+
+fun Name::space ($moo) { $moo }
+
+is(foo('baz'), 'baz');
+is(korv(qw/a b c/), 'a-c');
+is(array(10, 1..10), 20);
+is_deeply(
+    [sort(hash(foo => 1, bar => 2))],
+    [sort(qw/foo bar/)],
+);
+
+is(Name::space('kooh'), 'kooh');

diff --git a/t/foreign/signatures/eval.t b/t/foreign/signatures/eval.t
new file mode 100644 (file)
index 0000000..a82d190
--- /dev/null
+++ b/t/foreign/signatures/eval.t
@@ -0,0 +1,32 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More tests => 8;
+
+use Function::Parameters;
+
+eval 'fun foo ($bar) { $bar }';
+ok(!$@, 'signatures parse in eval');
+diag $@ if $@;
+ok(\&foo, 'fun declared in eval');
+is(foo(42), 42, 'eval signature works');
+
+no Function::Parameters;
+
+$SIG{__WARN__} = sub {};
+eval 'fun bar ($baz) { $baz }';
+like($@, qr/requires explicit package name/, 'string eval disabled');
+
+{
+    use Function::Parameters;
+
+    eval 'fun bar ($baz) { $baz }';
+    ok(!$@, 'signatures parse in eval');
+    diag $@ if $@;
+    ok(\&bar, 'fun declared in eval');
+    is(bar(42), 42, 'eval signature works');
+}
+
+$SIG{__WARN__} = sub {};
+eval 'fun moo ($kooh) { $kooh }';
+like($@, qr/requires explicit package name/, 'string eval disabled');

diff --git a/t/foreign/signatures/proto.t b/t/foreign/signatures/proto.t
new file mode 100644 (file)
index 0000000..ded1cc4
--- /dev/null
+++ b/t/foreign/signatures/proto.t
@@ -0,0 +1,43 @@
+#!perl
+use strict;
+use warnings;
+use Test::More tests => 7;
+
+use vars qw/@warnings/;
+BEGIN { $SIG{__WARN__} = sub { push @warnings, @_ } }
+
+BEGIN { is(@warnings, 0, 'no warnings yet') }
+
+use Function::Parameters;
+
+fun with_proto ($x, $y, $z) : ($$$) {
+    return $x + $y + $z;
+}
+
+{
+    my $foo;
+    fun with_lvalue () : () lvalue { $foo }
+}
+
+is(prototype('with_proto'), '$$$', ':proto attribute');
+
+is(prototype('with_lvalue'), '', ':proto with other attributes');
+with_lvalue = 1;
+is(with_lvalue, 1, 'other attributes still there');
+
+BEGIN { is(@warnings, 0, 'no warnings with correct :proto declarations') }
+
+fun invalid_proto ($x) : (invalid) { $x }
+
+BEGIN {
+    TODO: {
+        local $TODO = ':proto checks not yet implemented';
+        is(@warnings, 1, 'warning with illegal :proto');
+        like(
+            $warnings[0],
+            qr/Illegal character in prototype for fun invalid_proto : invalid at /,
+            'warning looks sane',
+        );
+    }
+}
+

diff --git a/t/foreign/signatures/weird.t b/t/foreign/signatures/weird.t
new file mode 100644 (file)
index 0000000..82d1093
--- /dev/null
+++ b/t/foreign/signatures/weird.t
@@ -0,0 +1,21 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More tests => 2;
+
+use Function::Parameters;
+
+  fun
+   foo
+ ($bar, $baz)
+       { return q{($bar, $baz) is }.qq{("$bar", "$baz")} }
+
+  my $moo
+    =
+   fun
+ ($bar, $baz)
+       { return q{($bar, $baz) is }.qq{("$bar", "$baz")} };
+
+is(foo(qw/affe zomtec/),   '($bar, $baz) is ("affe", "zomtec")');
+is($moo->(qw/korv wurst/), '($bar, $baz) is ("korv", "wurst")');
+