From: Vincent Pit <vince@profvince.com>
Date: Sat, 30 Aug 2008 20:14:16 +0000 (+0200)
Subject: Add prototype tests in t/12-proto.t
X-Git-Tag: v0.03~2
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fsubs-auto.git;a=commitdiff_plain;h=2ef1324275671d20b6a2471166250154541fff1d

Add prototype tests in t/12-proto.t
---

diff --git a/MANIFEST b/MANIFEST
index bbcbcbf..71dafbe 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -9,6 +9,7 @@ t/00-load.t
 t/05-args.t
 t/10-base.t
 t/11-pkg.t
+t/12-proto.t
 t/90-boilerplate.t
 t/91-pod.t
 t/92-pod-coverage.t
diff --git a/t/12-proto.t b/t/12-proto.t
new file mode 100644
index 0000000..db7b135
--- /dev/null
+++ b/t/12-proto.t
@@ -0,0 +1,35 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+my $foo;
+sub foo ($) { $foo = $_[0] };
+
+my $baz;
+eval q|
+ use warnings qw/FATAL redefine prototype/;
+ sub main::baz ($) { $baz = $_[0] }
+|;
+like($@, qr/Prototype\s+mismatch\s*:\s+sub\s+main::baz\s*:\s+none\s+vs\s+\(\$\)/, 'baz appears as prototyped');
+
+use subs::auto;
+
+eval { my @x = (1, 5); foo @x };
+is($@, '', 'foo was compiled ok');
+is($foo, 2, 'foo was called with the right arguments');
+
+my $bar;
+sub bar (\@) { $bar = 0; $bar += $_ for grep defined, @{$_[0]}  }
+
+eval { my @x = (2, 3, 4); bar @x };
+is($@, '', 'bar was compiled ok');
+is($bar, 9, 'bar was called with the right arguments');
+
+eval { baz 5 };
+like($@, qr/^Undefined\s+subroutine\s+&?main::baz/,'baz couldn\'t be compiled');
+is($baz, undef, 'baz can\'t be called because of the prototype mismatch');
+
+no subs::auto;