From: Lukas Mai Date: Wed, 14 Nov 2012 17:22:48 +0000 (+0100) Subject: import more Method::Signatures tests X-Git-Tag: v1.00_02~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=700071de3f0252907d4aa24f3bfddc6cc4717860;p=p5sagit%2FFunction-Parameters.git import more Method::Signatures tests --- diff --git a/MANIFEST b/MANIFEST index 690db90..47bd475 100644 --- a/MANIFEST +++ b/MANIFEST @@ -40,12 +40,15 @@ t/foreign/Method-Signatures/array_param.t t/foreign/Method-Signatures/at_underscore.t t/foreign/Method-Signatures/attributes.t t/foreign/Method-Signatures/caller.t +t/foreign/Method-Signatures/comments.t t/foreign/Method-Signatures/defaults.t t/foreign/Method-Signatures/error_interruption.t t/foreign/Method-Signatures/func.t t/foreign/Method-Signatures/invocant.t t/foreign/Method-Signatures/larna.t +t/foreign/Method-Signatures/lib/Bad.pm t/foreign/Method-Signatures/lib/BarfyDie.pm +t/foreign/Method-Signatures/lib/MooseLoadTest.pm t/foreign/Method-Signatures/method.t t/foreign/Method-Signatures/named.t t/foreign/Method-Signatures/odd_number.t @@ -55,7 +58,11 @@ t/foreign/Method-Signatures/paren_on_own_line.t t/foreign/Method-Signatures/paren_plus_open_block.t t/foreign/Method-Signatures/required.t t/foreign/Method-Signatures/slurpy.t +t/foreign/Method-Signatures/syntax_errors.t t/foreign/Method-Signatures/too_many_args.t +t/foreign/Method-Signatures/type_check.t +t/foreign/Method-Signatures/typeload_moose.t +t/foreign/Method-Signatures/typeload_notypes.t t/foreign/MooseX-Method-Signatures/attributes.t t/foreign/MooseX-Method-Signatures/caller.t t/foreign/MooseX-Method-Signatures/errors.t diff --git a/Parameters.xs b/Parameters.xs index 762ed3f..64099fc 100644 --- a/Parameters.xs +++ b/Parameters.xs @@ -540,7 +540,7 @@ static SV *reify_type(pTHX_ Sentinel sen, const SV *declarator, SV *name) { PUSHs(name); PUTBACK; - n = call_pv("Moose::Util::TypeConstraints::find_or_parse_type_constraint", G_SCALAR); + n = call_pv("Moose::Util::TypeConstraints::find_or_create_isa_type_constraint", G_SCALAR); SPAGAIN; assert(n == 1); diff --git a/t/foreign/Method-Signatures/comments.t b/t/foreign/Method-Signatures/comments.t new file mode 100644 index 0000000..34bf716 --- /dev/null +++ b/t/foreign/Method-Signatures/comments.t @@ -0,0 +1,66 @@ +#!perl +use strict; +use warnings FATAL => 'all'; + +use Test::More + eval { require Moose; 1 } + ? (tests => 2) + : (skip_all => "Moose required for testing types") +; +use Test::Fatal; + +use Function::Parameters qw(:strict); + + +is exception +{ + eval q{ + fun foo ( + Int :$foo, # this is foo + Int :$bar # this is bar + ) + { + } + + 1; + } or die; +}, undef, +'survives comments within the signature itself'; + +is exception +{ + eval q{ + fun bar ( Int :$foo, Int :$bar ) # this is a signature + { + } + + 1; + } or die; +}, undef, +'survives comments between signature and open brace'; + +#SKIP: +#{ +# eval { require MooseX::Declare } or skip "MooseX::Declare required for this test", 1; +# +# lives_ok +# { +# eval q{ +# use MooseX::Declare; +# use Method::Signatures::Modifiers; +# +# class Foo +# { +# method bar ( Int :$foo, Int :$bar ) # this is a signature +# { +# } +# } +# +# 1; +# } or die; +# } +# 'survives comments between signature and open brace'; +#} +# +# +#done_testing(); diff --git a/t/foreign/Method-Signatures/lib/Bad.pm b/t/foreign/Method-Signatures/lib/Bad.pm new file mode 100644 index 0000000..d41379f --- /dev/null +++ b/t/foreign/Method-Signatures/lib/Bad.pm @@ -0,0 +1,15 @@ +package Bad; + +use strict; +use warnings; +use Function::Parameters qw(:strict); + +## $info->{} should be $info{} +method meth1 ($foo) { + my %info; + $info->{xpto} = 1; +} + +method meth2 ($bar) {} + +'ok' diff --git a/t/foreign/Method-Signatures/lib/MooseLoadTest.pm b/t/foreign/Method-Signatures/lib/MooseLoadTest.pm new file mode 100644 index 0000000..910eab8 --- /dev/null +++ b/t/foreign/Method-Signatures/lib/MooseLoadTest.pm @@ -0,0 +1,12 @@ +# package for t/typeload_moose.t +# (see comments there for why check_paramized_sref is here) + +package Foo::Bar; + +use Moose; +use Function::Parameters qw(:strict); + +method check_int (Int $bar) {}; +method check_paramized_sref (ScalarRef[Num] $bar) {}; + +1; diff --git a/t/foreign/Method-Signatures/syntax_errors.t b/t/foreign/Method-Signatures/syntax_errors.t new file mode 100644 index 0000000..d014554 --- /dev/null +++ b/t/foreign/Method-Signatures/syntax_errors.t @@ -0,0 +1,19 @@ +#!perl +use strict; +use warnings FATAL => 'all'; + +use Test::More; + +use Dir::Self; +use lib __DIR__ . '/lib'; + +ok !eval { require Bad }; +#TODO: { +# local $TODO = "The user should see the actual syntax error"; + like $@, qr{^Global symbol "\$info" requires explicit package name}m; + +# like($@, qr{^PPI failed to find statement for '\$bar'}m, +# 'Bad syntax generates stack trace'); +#} + +done_testing(); diff --git a/t/foreign/Method-Signatures/type_check.t b/t/foreign/Method-Signatures/type_check.t new file mode 100644 index 0000000..1a51914 --- /dev/null +++ b/t/foreign/Method-Signatures/type_check.t @@ -0,0 +1,139 @@ +#!perl + +use strict; +use warnings FATAL => 'all'; + +use Test::More + eval { require Moose; 1 } + ? () + : (skip_all => "Moose required for testing types") +; +use Test::More; +use Test::Fatal; + +use Function::Parameters qw(:strict); + + +{ package Foo::Bar; sub new { bless {}, __PACKAGE__; } } +{ package Foo::Baz; sub new { bless {}, __PACKAGE__; } } + +our $foobar = Foo::Bar->new; +our $foobaz = Foo::Baz->new; + + +# types to check below +# the test name needs to be interpolated into a method name, so it must be a valid identifier +# either good value or bad value can be an array reference: +# * if it is, it is taken to be multiple values to try +# * if you want to pass an array reference, you have to put it inside another array reference +# * so, [ 42, undef ] makes two calls: one with 42, and one with undef +# * but [[ 42, undef ]] makes one call, passing [ 42, undef ] +our @TYPES = +( +## Test Name => Type => Good Value => Bad Value + int => 'Int' => 42 => 'foo' , + bool => 'Bool' => 0 => 'fool' , + aref => 'ArrayRef', => [[ 42, undef ]] => 42 , + class => 'Foo::Bar' => $foobar => $foobaz , + maybe_int => 'Maybe[Int]' => [ 42, undef ] => 'foo' , + paramized_aref => 'ArrayRef[Num]' => [[ 6.5, 42, 1e23 ]] => [[ 6.5, 42, 'thing' ]] , + paramized_href => 'HashRef[Num]' => { a => 6.5, b => 2, c => 1e23 } => { a => 6.5, b => 42, c => 'thing' } , +## ScalarRef[X] not implemented in Mouse, so this test is moved to typeload_moose.t +## if Mouse starts supporting it, the test could be restored here + paramized_sref => 'ScalarRef[Num]' => \42 => \'thing' , + int_or_aref => 'Int|ArrayRef[Int]' => [ 42 , [42 ] ] => 'foo' , +); + + +our $tester; +{ + package TypeCheck::Class; + + use Test::More; + use Test::Fatal; + + method new ($class:) { bless {}, $class; } + + sub _list { return ref $_[0] eq 'ARRAY' ? @{$_[0]} : ( $_[0] ); } + + + $tester = __PACKAGE__->new; + while (@TYPES) + { + my ($name, $type, $goodval, $badval) = splice @TYPES, 0, 4; + note "name/type/goodval/badval $name/$type/$goodval/$badval"; + my $method = "check_$name"; + no strict 'refs'; + + # make sure the declaration of the method doesn't throw a warning + is eval qq{ method $method ($type \$bar) {} 42 }, 42; + is $@, ''; + + # positive test--can we call it with a good value? + my @vals = _list($goodval); + my $count = 1; + foreach (@vals) + { + my $tag = @vals ? ' (alternative ' . $count++ . ')' : ''; + is exception { $tester->$method($_) }, undef, "call with good value for $name passes" . $tag; + } + + # negative test--does calling it with a bad value throw an exception? + @vals = _list($badval); + $count = 1; + foreach (@vals) + { + my $tag = @vals ? ' (#' . $count++ . ')' : ''; + like exception { $tester->$method($_) }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, + "call with bad value for $name dies"; + } + } + + + # try some mixed (i.e. some with a type, some without) and multiples + + my $method = 'check_mixed_type_first'; + is eval qq{ method $method (Int \$bar, \$baz) {} 42 }, 42; + is exception { $tester->$method(0, 'thing') }, undef, 'call with good values (type, notype) passes'; + like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, + 'call with bad values (type, notype) dies'; + + $method = 'check_mixed_type_second'; + is eval qq{ method $method (\$bar, Int \$baz) {} 42 }, 42; + is exception { $tester->$method('thing', 1) }, undef, 'call with good values (notype, type) passes'; + like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 2\b.+\$baz\b.+Validation failed for '[^']+' with value\b/, + 'call with bad values (notype, type) dies'; + + $method = 'check_multiple_types'; + is eval qq{ method $method (Int \$bar, Int \$baz) {} 42 }, 42; + is exception { $tester->$method(1, 1) }, undef, 'call with good values (type, type) passes'; + # with two types, and bad values for both, they should fail in order of declaration + like exception { $tester->$method('thing1', 'thing2') }, qr/method \Q$method\E.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, + 'call with bad values (type, type) dies'; + + # want to try one with undef as well to make sure we don't get an uninitialized warning + + like exception { $tester->check_int(undef) }, qr/method check_int.+parameter 1\b.+\$bar\b.+Validation failed for '[^']+' with value\b/, + 'call with bad values (undef) dies'; + + + + # finally, some types that shouldn't be recognized + my $type; + + #$method = 'unknown_type'; + #$type = 'Bmoogle'; + #is eval qq{ method $method ($type \$bar) {} 42 }, 42; + #like exception { $tester->$method(42) }, qr/ducks $tester, $type, "perhaps you forgot to load it?", $method/, + # 'call with unrecognized type dies'; + + # this one is a bit specialer in that it involved an unrecognized parameterization + $method = 'unknown_paramized_type'; + $type = 'Bmoogle[Int]'; + is eval qq{ method $method ($type \$bar) {} 42 }, undef; + like $@, qr/\QCould not locate the base type (Bmoogle)/; + like exception { $tester->$method(42) }, qr/\QCan't locate object method "unknown_paramized_type" via package "TypeCheck::Class"/; +} + + +done_testing; diff --git a/t/foreign/Method-Signatures/typeload_moose.t b/t/foreign/Method-Signatures/typeload_moose.t new file mode 100644 index 0000000..c3d08c0 --- /dev/null +++ b/t/foreign/Method-Signatures/typeload_moose.t @@ -0,0 +1,27 @@ +#!perl + +use strict; +use warnings FATAL => 'all'; +use Dir::Self; +use lib __DIR__ . '/lib'; + +use Test::More + eval { require Moose; 1 } + ? (tests => 2) + : (skip_all => "Moose required for testing types") +; + + +require MooseLoadTest; + +my $foobar = Foo::Bar->new; + +# can't check for type module not being loaded here, because Moose will drag it in + + +$foobar->check_int(42); + +# now we should have loaded Moose, not Mouse, to do our type checking + +is $INC{'Mouse/Util/TypeConstraints.pm'}, undef, "didn't load Mouse"; +like $INC{'Moose/Util/TypeConstraints.pm'}, qr{Moose/Util/TypeConstraints\.pm$}, 'loaded Moose'; diff --git a/t/foreign/Method-Signatures/typeload_notypes.t b/t/foreign/Method-Signatures/typeload_notypes.t new file mode 100644 index 0000000..71ad5ea --- /dev/null +++ b/t/foreign/Method-Signatures/typeload_notypes.t @@ -0,0 +1,39 @@ +#!perl + +use strict; +use warnings FATAL => 'all'; + +use Test::More; + + +{ + package Foo::Bar; + + use strict; + use warnings; + + use Function::Parameters qw(:strict); + + method new ($class:) { bless {}, $class; } + + # not using a type here, so we won't expect Moose *or* Mouse to get loaded + method foo1 ($bar) {}; +} + +my $foobar = Foo::Bar->new; + +# at this point, neither Mouse nor Moose should be loaded + +is $INC{'Mouse/Util/TypeConstraints.pm'}, undef, 'no type checking module loaded before method call'; +is $INC{'Moose/Util/TypeConstraints.pm'}, undef, 'no type checking module loaded before method call'; + + +$foobar->foo1(42); + +# _still_ should have no Moose and no Mouse, because we haven't requested any type checking + +is $INC{'Mouse/Util/TypeConstraints.pm'}, undef, 'no type checking module loaded before method call'; +is $INC{'Moose/Util/TypeConstraints.pm'}, undef, 'no type checking module loaded before method call'; + + +done_testing;