From: Lukas Mai <l.mai@web.de>
Date: Wed, 7 Nov 2012 20:42:27 +0000 (+0100)
Subject: import all tests from Fun
X-Git-Tag: v1.00_01~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=98478aff9d9998611e7fe5b8c46fdd25608d1261;p=p5sagit%2FFunction-Parameters.git

import all tests from Fun
---

diff --git a/MANIFEST b/MANIFEST
index 622f678..4fb8566 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -21,6 +21,17 @@ t/eating_strict_error.fail
 t/eating_strict_error.t
 t/eating_strict_error_2.fail
 t/elsewhere.t
+t/foreign/Fun/anon.t
+t/foreign/Fun/basic.t
+t/foreign/Fun/closure-proto.t
+t/foreign/Fun/compile-time.t
+t/foreign/Fun/defaults.t
+t/foreign/Fun/name.t
+t/foreign/Fun/package.t
+t/foreign/Fun/recursion.t
+t/foreign/Fun/slurpy-syntax-errors.t
+t/foreign/Fun/slurpy.t
+t/foreign/Fun/state.t
 t/foreign/Method-Signatures-Simple/02-use.t
 t/foreign/Method-Signatures-Simple/03-config.t
 t/foreign/Method-Signatures/anon.t
diff --git a/t/foreign/Fun/anon.t b/t/foreign/Fun/anon.t
new file mode 100644
index 0000000..3acb7c0
--- /dev/null
+++ b/t/foreign/Fun/anon.t
@@ -0,0 +1,16 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+use Function::Parameters;
+
+my $fun = fun ($x, $y) { $x * $y };
+
+is($fun->(3, 4), 12);
+
+my $fun2 = fun ($z, $w = 10) { $z / $w };
+
+is($fun2->(60), 6);
+
+done_testing;
diff --git a/t/foreign/Fun/basic.t b/t/foreign/Fun/basic.t
new file mode 100644
index 0000000..57c4e85
--- /dev/null
+++ b/t/foreign/Fun/basic.t
@@ -0,0 +1,32 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+use Function::Parameters;
+
+fun mul ($x, $y) {
+    return $x * $y;
+}
+
+is(mul(3, 4), 12);
+
+fun sum (@nums) {
+    my $sum;
+    for my $num (@nums) {
+        $sum += $num;
+    }
+    return $sum;
+}
+
+is(sum(1, 2, 3, 4), 10);
+
+{
+    package Foo;
+    use Function::Parameters;
+    fun foo { }
+}
+
+ok(exists $Foo::{foo});
+
+done_testing;
diff --git a/t/foreign/Fun/closure-proto.t b/t/foreign/Fun/closure-proto.t
new file mode 100644
index 0000000..d2ad51a
--- /dev/null
+++ b/t/foreign/Fun/closure-proto.t
@@ -0,0 +1,19 @@
+#!perl
+
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+use Function::Parameters;
+
+{
+    my $x = 10;
+
+    fun bar ($y) {
+        $x * $y
+    }
+}
+
+is(bar(3), 30);
+
+done_testing;
diff --git a/t/foreign/Fun/compile-time.t b/t/foreign/Fun/compile-time.t
new file mode 100644
index 0000000..5908b61
--- /dev/null
+++ b/t/foreign/Fun/compile-time.t
@@ -0,0 +1,12 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+use Function::Parameters;
+
+is(foo(), "FOO");
+
+fun foo { "FOO" }
+
+done_testing;
diff --git a/t/foreign/Fun/defaults.t b/t/foreign/Fun/defaults.t
new file mode 100644
index 0000000..198fec7
--- /dev/null
+++ b/t/foreign/Fun/defaults.t
@@ -0,0 +1,57 @@
+#!perl
+use strict;
+use warnings;
+use Test::More;
+
+use Function::Parameters;
+
+fun foo ($x, $y = 5) {
+    return $x + $y;
+}
+
+is(foo(3, 4), 7);
+is(foo(3), 8);
+{
+    my $warning;
+    local $SIG{__WARN__} = sub { $warning = $_[0] };
+    is(foo, 5);
+    like($warning, qr/Use of uninitialized value \$x in addition \(\+\)/);
+}
+
+fun bar ($baz, $quux = foo(1) * 2, $blorg = sub { return "ran sub, got " . $_[0] }) {
+    $blorg->($baz + $quux);
+}
+
+is(bar(3, 4, sub { $_[0] }), 7);
+is(bar(5, 6), "ran sub, got 11");
+is(bar(7), "ran sub, got 19");
+{
+    my $warning;
+    local $SIG{__WARN__} = sub { $warning = $_[0] };
+    is(bar, "ran sub, got 12");
+    like($warning, qr/Use of uninitialized value \$baz in addition \(\+\)/);
+}
+
+fun baz ($a, $b = our $FOO) {
+    return "$a $b";
+}
+
+{
+    no warnings 'misc'; # 'not imported' warning because we use $FOO later
+    eval '$FOO';
+    like($@, qr/Global symbol "\$FOO" requires explicit package name/, "doesn't leak scope");
+}
+
+our $FOO = "abc";
+is(baz("123"), "123 abc");
+
+fun goorch ($x, $y = []) {
+    return $y
+}
+
+my $goorch_y_1 = goorch( 10 );
+my $goorch_y_2 = goorch( 10 );
+
+isnt($goorch_y_1, $goorch_y_2, '... not the same reference');
+
+done_testing;
diff --git a/t/foreign/Fun/name.t b/t/foreign/Fun/name.t
new file mode 100644
index 0000000..d2370cd
--- /dev/null
+++ b/t/foreign/Fun/name.t
@@ -0,0 +1,47 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+use Carp;
+
+my $file = __FILE__;
+my $line = __LINE__;
+
+{
+    package Foo;
+    use Function::Parameters;
+    fun foo ($x, $y) {
+        Carp::confess "$x $y";
+    }
+
+    eval {
+        foo("abc", "123");
+    };
+
+    my $line_confess = $line + 6;
+    my $line_foo = $line + 10;
+
+    ::like($@, qr/^abc 123 at $file line $line_confess\.?\n\tFoo::foo\('abc', 123\) called at $file line $line_foo/);
+}
+
+SKIP: { skip "Sub::Name required", 1 unless eval { require Sub::Name };
+
+{
+    package Bar;
+    use Function::Parameters;
+    *bar = Sub::Name::subname(bar => fun ($a, $b) { Carp::confess($a + $b) });
+
+    eval {
+        bar(4, 5);
+    };
+
+    my $line_confess = $line + 24;
+    my $line_bar = $line + 27;
+
+    ::like($@, qr/^9 at $file line $line_confess\.?\n\tBar::bar\(4, 5\) called at $file line $line_bar/);
+}
+
+}
+
+done_testing;
diff --git a/t/foreign/Fun/package.t b/t/foreign/Fun/package.t
new file mode 100644
index 0000000..99d5364
--- /dev/null
+++ b/t/foreign/Fun/package.t
@@ -0,0 +1,16 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+use Function::Parameters;
+
+fun Foo::foo ($x, $y) {
+    $x + $y;
+}
+
+ok(!main->can('foo'));
+ok(Foo->can('foo'));
+is(Foo::foo(1, 2), 3);
+
+done_testing;
diff --git a/t/foreign/Fun/recursion.t b/t/foreign/Fun/recursion.t
new file mode 100644
index 0000000..7ebcdce
--- /dev/null
+++ b/t/foreign/Fun/recursion.t
@@ -0,0 +1,36 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+BEGIN {
+    if (!eval { require 5.016; 1 }) {
+        plan skip_all => "This test requires 5.16";
+    }
+}
+
+use 5.016;
+
+use Function::Parameters;
+
+fun fact ($n) {
+    if ($n < 2) {
+        return 1;
+    }
+    return $n * __SUB__->($n - 1);
+}
+
+is(fact(5), 120);
+
+is(fun ($n = 8) { $n < 2 ? 1 : $n * __SUB__->($n - 1) }->(), 40320);
+
+fun fact2 ($n) {
+    if ($n < 2) {
+        return 1;
+    }
+    return $n * fact2($n - 1);
+}
+
+is(fact2(5), 120);
+
+done_testing;
diff --git a/t/foreign/Fun/slurpy-syntax-errors.t b/t/foreign/Fun/slurpy-syntax-errors.t
new file mode 100644
index 0000000..be5f333
--- /dev/null
+++ b/t/foreign/Fun/slurpy-syntax-errors.t
@@ -0,0 +1,28 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+use Function::Parameters;
+
+{
+    eval 'fun ( $foo, @bar, $baz ) { return [] }';
+    ok $@, '... got an error';
+}
+
+{
+    eval 'fun ( $foo, %bar, $baz ) { return {} }';
+    ok $@, '... got an error';
+}
+
+{
+    eval 'fun ( $foo, @bar, %baz ) { return [] }';
+    ok $@, '... got an error';
+}
+
+{
+    eval 'fun ( $foo, %bar, @baz ) { return {} }';
+    ok $@, '... got an error';
+}
+
+done_testing;
diff --git a/t/foreign/Fun/slurpy.t b/t/foreign/Fun/slurpy.t
new file mode 100644
index 0000000..50d66c8
--- /dev/null
+++ b/t/foreign/Fun/slurpy.t
@@ -0,0 +1,19 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+use Function::Parameters;
+
+fun test_array ( $foo, @bar ) {
+    return [ $foo, @bar ];
+}
+
+fun test_hash ( $foo, %bar ) {
+    return { foo => $foo, %bar };
+}
+
+is_deeply( test_array( 1, 2 .. 10 ), [ 1, 2 .. 10 ], '... slurpy array worked' );
+is_deeply( test_hash( 1, ( two => 2, three => 3 ) ), { foo => 1, two => 2, three => 3 }, '... slurpy hash worked' );
+
+done_testing;
diff --git a/t/foreign/Fun/state.t b/t/foreign/Fun/state.t
new file mode 100644
index 0000000..6a05d24
--- /dev/null
+++ b/t/foreign/Fun/state.t
@@ -0,0 +1,17 @@
+#!perl
+
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+use 5.10.0;
+use Function::Parameters;
+
+fun bar ($y) {
+    state $x = 10;
+    $x * $y;
+}
+
+is(bar(3), 30);
+
+done_testing;