From: Lukas Mai Date: Sun, 28 Oct 2012 16:13:30 +0000 (+0100) Subject: import some (modified) signatures tests X-Git-Tag: v1.00~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=514bcaa66192a12977f415b644878fddd45529f3;p=p5sagit%2FFunction-Parameters.git import some (modified) signatures tests --- diff --git a/MANIFEST b/MANIFEST index 7ef9fa0..75d2ab5 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,11 +1,11 @@ Changes -lib/Function/Parameters.pm -Makefile.PL MANIFEST MANIFEST.SKIP -padop_on_crack.c.inc +Makefile.PL Parameters.xs README +lib/Function/Parameters.pm +padop_on_crack.c.inc t/00-load.t t/01-compiles.t t/02-compiles.t @@ -21,28 +21,6 @@ t/eating_strict_error.fail t/eating_strict_error.t t/eating_strict_error_2.fail t/elsewhere.t -t/imports.t -t/invocant.t -t/lexical.t -t/lineno-torture.t -t/lineno.t -t/named.t -t/named_1.fail -t/named_2.fail -t/named_3.fail -t/named_4.fail -t/pod.t -t/precedence.t -t/prototype.t -t/regress.t -t/rename.t -t/strict.t -t/strict_1.fail -t/strict_2.fail -t/strict_3.fail -t/strict_4.fail -t/strict_5.fail -t/unicode.t t/foreign/Method-Signatures/anon.t t/foreign/Method-Signatures/array_param.t t/foreign/Method-Signatures/attributes.t @@ -71,3 +49,30 @@ 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 +t/lineno-torture.t +t/lineno.t +t/named.t +t/named_1.fail +t/named_2.fail +t/named_3.fail +t/named_4.fail +t/pod.t +t/precedence.t +t/prototype.t +t/regress.t +t/rename.t +t/strict.t +t/strict_1.fail +t/strict_2.fail +t/strict_3.fail +t/strict_4.fail +t/strict_5.fail +t/unicode.t diff --git a/Parameters.xs b/Parameters.xs index 2031f0b..d6b69a7 100644 --- a/Parameters.xs +++ b/Parameters.xs @@ -673,6 +673,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 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 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 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 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 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")'); +