From: Lukas Mai <l.mai@web.de>
Date: Sat, 27 Oct 2012 13:30:05 +0000 (+0200)
Subject: steal more tests from other modules
X-Git-Tag: v0.10_02~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=98e6239b969281c227be6ede859054786dd7b933;p=p5sagit%2FFunction-Parameters.git

steal more tests from other modules
---

diff --git a/t/foreign/Method-Signatures/at_underscore.t b/t/foreign/Method-Signatures/at_underscore.t
new file mode 100644
index 0000000..dc540ac
--- /dev/null
+++ b/t/foreign/Method-Signatures/at_underscore.t
@@ -0,0 +1,20 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More;
+
+{
+    package Foo;
+    use Function::Parameters qw(:strict);
+
+    fun foo { return @_ }
+    method bar { return @_ }
+}
+
+is_deeply [Foo::foo()], [];
+is_deeply [Foo::foo(23, 42)], [23, 42];
+is_deeply [Foo->bar()], [];
+is_deeply [Foo->bar(23, 42)], [23, 42];
+
+done_testing;
diff --git a/t/foreign/Method-Signatures/invocant.t b/t/foreign/Method-Signatures/invocant.t
index 3d53241..4242aee 100644
--- a/t/foreign/Method-Signatures/invocant.t
+++ b/t/foreign/Method-Signatures/invocant.t
@@ -39,9 +39,9 @@ our $skip_no_invocants;
             $self->bar($arg);
         }
 
-#        method no_invocant_named_param($arg) {
-#            $self->bar($arg);
-#        }
+        method no_invocant_named_param(:$arg) {
+            $self->bar($arg);
+        }
 
     };
     is $@, '', 'compiles without invocant';
@@ -64,4 +64,4 @@ is( Stuff->without_space(42),       42 );
 
 my $stuff = Stuff->new;
 is( $stuff->no_invocant_class_type(Foo::Bar->new),     'Foo::Bar' );
-#is( $stuff->no_invocant_named_param(arg => Foo->new),  'Foo' );
+is( $stuff->no_invocant_named_param(arg => Foo->new),  'Foo' );
diff --git a/t/foreign/Method-Signatures/named.t b/t/foreign/Method-Signatures/named.t
new file mode 100644
index 0000000..ec370d8
--- /dev/null
+++ b/t/foreign/Method-Signatures/named.t
@@ -0,0 +1,54 @@
+#!perl
+use warnings FATAL => 'all';
+use strict;
+
+use Test::More;
+
+{
+    package Foo;
+
+    use Test::More;
+    use Test::Fatal;;
+    use Function::Parameters qw(:strict);
+
+    method formalize($text, :$justify = "left", :$case = undef) {
+        my %params;
+        $params{text}           = $text;
+        $params{justify}        = $justify;
+        $params{case}           = $case if defined $case;
+
+        return \%params;
+    }
+
+    is_deeply( Foo->formalize( "stuff" ), { text => "stuff", justify => "left" } );
+
+    like exception { Foo->formalize( "stuff", wibble => 23 ) }, qr/\bnamed\b.+\bwibble\b/;
+
+    method foo( :$arg ) {
+        return $arg;
+    }
+
+    is( Foo->foo( arg => 42 ), 42 );
+    like exception { foo() }, qr/Not enough arguments/;
+
+
+    # Compile time errors need internal refactoring before I can get file, line and method
+    # information.
+    eval q{
+        method wrong( :$named, $pos ) {}
+    };
+    like $@, qr/\bpositional\b.+\$pos\b.+\bnamed\b.+\$named\b/;
+
+    eval q{
+        method wrong( $foo, :$named, $bar ) {}
+    };
+    like $@, qr/\bpositional\b.+\$bar\b.+\bnamed\b.+\$named\b/;
+
+    eval q{
+        method wrong( $foo, $bar = undef, :$named ) {}
+    };
+    like $@, qr/\boptional positional\b.+\$bar\b.+\brequired named\b.+\$named\b/;
+}
+
+
+done_testing();
diff --git a/t/foreign/Method-Signatures/odd_number.t b/t/foreign/Method-Signatures/odd_number.t
new file mode 100644
index 0000000..254b98a
--- /dev/null
+++ b/t/foreign/Method-Signatures/odd_number.t
@@ -0,0 +1,16 @@
+#!perl
+
+package Foo;
+use warnings FATAL => 'all';
+use strict;
+
+use Test::More tests => 1;
+use Test::Fatal;
+
+use Function::Parameters qw(:strict);
+
+method foo(:$name, :$value) {
+    return $name, $value;
+}
+
+like exception { Foo->foo(name => 42, value =>) }, qr/Not enough arguments/;
diff --git a/t/foreign/Method-Signatures/optional.t b/t/foreign/Method-Signatures/optional.t
index 6c0f960..825ef98 100644
--- a/t/foreign/Method-Signatures/optional.t
+++ b/t/foreign/Method-Signatures/optional.t
@@ -34,11 +34,10 @@ use Test::More;
     is( Stuff->some_optional(18), 18 );
 
 
-#    # are named parameters optional by default?
-#    method named_params(:$this, :$that) {}
-#
-#    lives_ok { Stuff->named_params(this => 0) } 'can leave out some named params';
-#    lives_ok { Stuff->named_params(         ) } 'can leave out all named params';
+    method named_params(:$this = undef, :$that = undef) {}
+
+    is exception { Stuff->named_params(this => 0) }, undef, 'can leave out some named params';
+    is exception { Stuff->named_params(         ) }, undef, 'can leave out all named params';
 
 
     # are slurpy parameters optional by default?
diff --git a/t/foreign/Method-Signatures/required.t b/t/foreign/Method-Signatures/required.t
new file mode 100644
index 0000000..1f269bf
--- /dev/null
+++ b/t/foreign/Method-Signatures/required.t
@@ -0,0 +1,34 @@
+#!perl
+
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More;
+
+
+{
+    package Stuff;
+
+    use Test::More;
+    use Test::Fatal;
+    use Function::Parameters qw(:strict);
+
+    method whatever($this) {
+        return $this;
+    }
+
+    is( Stuff->whatever(23),    23 );
+
+    like exception { Stuff->whatever() }, qr/Not enough arguments/;
+
+    method some_optional($that, $this = 22) {
+        return $that + $this
+    }
+
+    is( Stuff->some_optional(18), 18 + 22 );
+
+    like exception { Stuff->some_optional() }, qr/Not enough arguments/;
+}
+
+
+done_testing();
diff --git a/t/foreign/Method-Signatures/slurpy.t b/t/foreign/Method-Signatures/slurpy.t
index 63e106c..b9c4fcf 100644
--- a/t/foreign/Method-Signatures/slurpy.t
+++ b/t/foreign/Method-Signatures/slurpy.t
@@ -32,15 +32,8 @@ use Test::More;
         like $@, qr{\bslurpy_middle\b};
     }
 
-#    ok !eval q[fun slurpy_positional(:@that) { return \@that; }];
-#    like $@, qr{slurpy parameter \@that cannot be named, use a reference instead};
-#
-#    TODO: {
-#        local $TODO = "error message incorrect inside an eval";
-#
-#        like $@, qr{Stuff::};
-#        like $@, qr{slurpy_positional\(\)};
-#    }
+    ok !eval q[fun slurpy_positional(:@that) { return \@that; }];
+    like $@, qr{\bnamed\b.+\@that\b.+\barray\b};
 
     ok !eval q[fun slurpy_two($this, @that, @other) { return $this, \@that, \@other }];
     like $@, qr{\@that\b.+\@other\b};
diff --git a/t/foreign/Method-Signatures/too_many_args.t b/t/foreign/Method-Signatures/too_many_args.t
new file mode 100644
index 0000000..7f5ebd3
--- /dev/null
+++ b/t/foreign/Method-Signatures/too_many_args.t
@@ -0,0 +1,44 @@
+#!perl
+
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More;
+
+use Function::Parameters qw(:strict);
+
+fun no_sig { return @_ }
+fun no_args() { return @_ }
+fun one_arg($foo) { return $foo }
+fun two_args($foo, $bar) { return ($foo, $bar) }
+fun array_at_end($foo, @stuff) { return ($foo, @stuff) }
+fun one_named(:$foo) { return $foo; }
+fun one_named_one_positional($bar, :$foo) { return($foo, $bar) }
+
+note "too many arguments"; {
+	is_deeply [no_sig(42)], [42];
+
+    ok !eval { no_args(42); 1 },                                   "no args";
+    like $@, qr{Too many arguments};
+
+    ok !eval { one_arg(23, 42); 1 },                               "one arg";
+    like $@, qr{Too many arguments};
+
+    ok !eval { two_args(23, 42, 99); 1 },                          "two args";
+    like $@, qr{Too many arguments};
+
+    is_deeply [array_at_end(23, 42, 99)], [23, 42, 99],         "array at end";
+}
+
+
+note "with positionals"; {
+    is one_named(foo => 42), 42;
+    is one_named(foo => 23, foo => 42), 42;
+
+
+    is_deeply [one_named_one_positional(23, foo => 42)], [42, 23];
+    is_deeply [one_named_one_positional(23, foo => 42, foo => 23)], [23, 23];
+}
+
+
+done_testing;
diff --git a/t/foreign/MooseX-Method-Signatures/list.t b/t/foreign/MooseX-Method-Signatures/list.t
index 1bb1051..7309114 100644
--- a/t/foreign/MooseX-Method-Signatures/list.t
+++ b/t/foreign/MooseX-Method-Signatures/list.t
@@ -1,7 +1,7 @@
 #!perl
 use strict;
 use warnings FATAL => 'all';
-use Test::More tests => 21;
+use Test::More tests => 23;
 use Test::Fatal;
 use Function::Parameters qw(:strict);
 
@@ -70,10 +70,10 @@ my $o = bless {} => 'Foo';
     is(exception { $meth->($o, 'foo', 42, 23) }, undef);
 }
 
-#{
-#    eval 'my $meth = method (:$foo, :@bar) { }';
-#    like $@, qr/arrays or hashes cannot be named/i;
-#
-#    eval 'my $meth = method ($foo, @bar, :$baz) { }';
-#    like $@, qr/named parameters can not be combined with slurpy positionals/i;
-#}
+{
+    eval 'my $meth = method (:$foo, :@bar) { }';
+    like $@, qr/\bnamed\b.+\bbar\b.+\barray\b/;
+
+    eval 'my $meth = method ($foo, @bar, :$baz) { }';
+    like $@, qr/\bbar\b.+\bbaz\b/;
+}
diff --git a/t/foreign/MooseX-Method-Signatures/named_defaults.t b/t/foreign/MooseX-Method-Signatures/named_defaults.t
new file mode 100644
index 0000000..b71de88
--- /dev/null
+++ b/t/foreign/MooseX-Method-Signatures/named_defaults.t
@@ -0,0 +1,20 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More;
+
+{
+    package Foo;
+
+    use Function::Parameters qw(:strict);
+
+	method new($class:) { bless {}, $class }
+    method bar (:$baz = 42) { $baz }
+}
+
+my $o = Foo->new;
+is($o->bar, 42);
+is($o->bar(baz => 0xaffe), 0xaffe);
+
+done_testing;
diff --git a/t/foreign/MooseX-Method-Signatures/undef_method_arg.t b/t/foreign/MooseX-Method-Signatures/undef_method_arg.t
index b149bcf..cae6717 100644
--- a/t/foreign/MooseX-Method-Signatures/undef_method_arg.t
+++ b/t/foreign/MooseX-Method-Signatures/undef_method_arg.t
@@ -10,22 +10,22 @@ use Test::Fatal;
 
 	method new($class:) { bless {}, $class }
 
-#    method m1(:$bar!) { }
-#    method m2(:$bar?) { }
-#    method m3(:$bar ) { }
+    method m1(:$bar ) { }
+    method m2(:$bar = undef) { }
+    method m3(:$bar ) { }
 
-#    method m4( $bar!) { }
+    method m4( $bar ) { }
     method m5( $bar = undef ) { }
     method m6( $bar ) { }
 }
 
 my $foo = Foo->new;
 
-#is(exception { $foo->m1(bar => undef) }, undef, 'Explicitly pass undef to positional required arg');
-#is(exception { $foo->m2(bar => undef) }, undef, 'Explicitly pass undef to positional explicit optional arg');
-#is(exception { $foo->m3(bar => undef) }, undef, 'Explicitly pass undef to positional implicit optional arg');
+is(exception { $foo->m1(bar => undef) }, undef, 'Explicitly pass undef to positional required arg');
+is(exception { $foo->m2(bar => undef) }, undef, 'Explicitly pass undef to positional explicit optional arg');
+is(exception { $foo->m3(bar => undef) }, undef, 'Explicitly pass undef to positional implicit optional arg');
 
-#is(exception { $foo->m4(undef) }, undef, 'Explicitly pass undef to required arg');
+is(exception { $foo->m4(undef) }, undef, 'Explicitly pass undef to required arg');
 is(exception { $foo->m5(undef) }, undef, 'Explicitly pass undef to explicit required arg');
 is(exception { $foo->m6(undef) }, undef, 'Explicitly pass undef to implicit required arg');