From: Lukas Mai <l.mai@web.de>
Date: Tue, 2 Aug 2011 06:34:44 +0000 (+0200)
Subject: more better tests
X-Git-Tag: v0.05~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5bf140a10b6d535ec9e96bbaa0db268c92e534a6;p=p5sagit%2FFunction-Parameters.git

more better tests
---

diff --git a/Makefile.PL b/Makefile.PL
index 51e68a0..1b0f5bb 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -11,13 +11,16 @@ WriteMakefile(
       ? ('LICENSE'=> 'perl')
       : ()),
     PL_FILES            => {},
+    BUILD_REQUIRES => {
+    	'Dir::Self' => 0,
+    },
     PREREQ_PM => {
         'Test::More' => 0,
         'warnings' => 0,
         'strict' => 0,
         'Devel::Declare' => 0,
         'B::Hooks::EndOfScope' => 0,
-        'B::Compiling' => 0,
+        'Carp' => 0,
     },
     dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
     clean               => { FILES => 'Function-Parameters-*' },
diff --git a/t/01-compiles.t b/t/01-compiles.t
index 89129eb..503ab57 100644
--- a/t/01-compiles.t
+++ b/t/01-compiles.t
@@ -13,17 +13,17 @@ fun id_2
  (
  	 $x
  )
- :
+ : #hello
  (
   $
  )
- {
+ {@_ == 1 or return;
  	 $x
  }
 
 fun id_3 ##
  (  $x ##
- ) ##
+ ) ##AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
  { ##
  	 $x ##
  } ##
diff --git a/t/02-compiles.t b/t/02-compiles.t
new file mode 100644
index 0000000..4128807
--- /dev/null
+++ b/t/02-compiles.t
@@ -0,0 +1,62 @@
+#!perl
+
+use Test::More tests => 10;
+
+use warnings FATAL => 'all';
+use strict;
+
+use Function::Parameters;
+
+method id_1() { $self }
+
+method id_2
+ (
+
+ )
+ : #hello
+ (
+  $
+ )
+ {@_ == 0 or return;
+ 	 $self
+ }
+
+method##
+    id_3 ##
+ (   ##
+ 	 #
+ ) ##AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
+ { ##
+ 	  ##
+ } ##
+
+method add($y) {
+	$self + $y
+}
+
+method mymap(@args) :(&@) {
+  my @res;
+  for (@args) {
+    push @res, $self->($_);
+  }
+  @res
+}
+
+method fac_1() {
+	$self < 2 ? 1 : $self * fac_1 $self - 1
+}
+
+method fac_2() :($) {
+	$self < 2 ? 1 : $self * fac_2 $self - 1
+}
+
+ok id_1 1;
+ok id_1(1), 'basic sanity';
+ok id_2 1, 'simple prototype';
+ok id_3(1), 'definition over multiple lines';
+is add(2, 2), 4, '2 + 2 = 4';
+is add(39, 3), 42, '39 + 3 = 42';
+is_deeply [mymap { $_ * 2 } 2, 3, 5, 9], [4, 6, 10, 18], 'mymap works';
+is fac_1(5), 120, 'fac_1';
+is fac_2 6, 720, 'fac_2';
+is method ($y) { $self . $y }->(method () { $self + 1 }->(3), method () { $self * 2 }->(1)), '42', 'anonyfun';
diff --git a/t/eating_strict_error.fail b/t/eating_strict_error.fail
new file mode 100644
index 0000000..8048652
--- /dev/null
+++ b/t/eating_strict_error.fail
@@ -0,0 +1,11 @@
+use strict;
+use Function::Parameters;
+
+fun get_record( $agent, $target_name ) {
+	for my $record ( @$records ) {
+	}
+}
+
+fun get_ip( $agent ) {
+}
+
diff --git a/t/eating_strict_error.t b/t/eating_strict_error.t
new file mode 100644
index 0000000..8b884d4
--- /dev/null
+++ b/t/eating_strict_error.t
@@ -0,0 +1,19 @@
+#!perl
+
+use Test::More tests => 2;
+
+use warnings FATAL => 'all';
+use strict;
+
+use Dir::Self;
+
+#use Test::Fatal;
+
+my $file = __DIR__ . "/eating_strict_error.fail";
+my $done = do $file;
+my $exc = $@;
+my $err = $!;
+
+is $done, undef, "faulty code doesn't load";
+is $exc, qq{Global symbol "\$records" requires explicit package name at $file line 5.\nBEGIN not safe after errors--compilation aborted at $file line 9.\n};
+$exc or die "$file: $err";
diff --git a/t/rename.t b/t/rename.t
index e35c5b0..217c59d 100644
--- a/t/rename.t
+++ b/t/rename.t
@@ -8,12 +8,40 @@ my $add = f ($x, $y) { $x + $y };
 
 is $add->(2, 4), 6;
 
-ok !eval { Function::Parameters->import('g', 'h'); 1 };
-like $@, qr/ is not exported /;
+ok !eval { Function::Parameters->import('g', 'h', 'i'); 1 };
 
 for my $kw ('', '42', 'A::B', 'a b') {
 	ok !eval{ Function::Parameters->import($kw); 1 };
 	like $@, qr/valid identifier /;
 }
 
+use Function::Parameters 'func_a', 'meth_a';
+
+func_a cat_a($x, $y) {
+	$x . $y
+}
+
+meth_a tac_a($x) {
+	$x . $self
+}
+
+is cat_a('ab', 'cde'), 'abcde';
+is tac_a('ab', 'cde'), 'cdeab';
+
+use Function::Parameters {
+	meth_b => 'method',
+	func_b => 'function',
+};
+
+func_b cat_b($x, $y) {
+	$x . $y
+}
+
+meth_b tac_b($x) {
+	$x . $self
+}
+
+is cat_b('ab', 'cde'), 'abcde';
+is tac_b('ab', 'cde'), 'cdeab';
+
 done_testing;