import more Method::Signatures tests

diff --git a/MANIFEST b/MANIFEST
index 690db90..47bd475 100644 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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;