From: Lukas Mai <l.mai@web.de>
Date: Sat, 23 Jun 2012 14:49:54 +0000 (+0200)
Subject: add *_strict variants of all symbolic types
X-Git-Tag: v0.06_01~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7817d698ba4e55c46484533c96bd45ee8b02e502;p=p5sagit%2FFunction-Parameters.git

add *_strict variants of all symbolic types
---

diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm
index 305f9ec..1eeae05 100644
--- a/lib/Function/Parameters.pm
+++ b/lib/Function/Parameters.pm
@@ -48,6 +48,12 @@ my %type_map = (
 		shift => '$class',
 	},
 );
+for my $k (keys %type_map) {
+	$type_map{$k . '_strict'} = {
+		%{$type_map{$k}},
+		check_argument_count => 1,
+	};
+}
 
 sub import {
 	my $class = shift;
@@ -242,8 +248,9 @@ Or more concretely:
 The first line creates two keywords, C<proc> and C<meth> (for defining
 functions and methods, respectively). The last two lines only create one
 keyword. Generally the hash keys (keywords) can be any identifiers you want
-while the values (types) have to be either C<'function'>, C<'method'>,
-C<'classmethod'>, or a hash reference (see below). The main difference between
+while the values (types) have to be either a hash reference (see below) or
+C<'function'>, C<'method'>, C<'classmethod'>, C<'function_strict'>,
+C<'method_strict'>, or C<'classmethod_strict'>. The main difference between
 C<'function'> and C<'method'> is that C<'method'>s automatically
 L<shift|perlfunc/shift> their first argument into C<$self> (C<'classmethod'>s
 are similar but shift into C<$class>).
@@ -382,6 +389,9 @@ Plain C<'function'> is equivalent to:
 
 (These are all default values so C<'function'> is also equivalent to C<{}>.)
 
+C<'function_strict'> is like C<'function'> but with
+C<< check_argument_count => 1 >>.
+
 C<'method'> is equivalent to:
 
  {
@@ -392,6 +402,9 @@ C<'method'> is equivalent to:
    shift => '$self',
  }
 
+C<'method_strict'> is like C<'method'> but with
+C<< check_argument_count => 1 >>.
+
 C<'classmethod'> is equivalent to:
 
  {
@@ -402,6 +415,9 @@ C<'classmethod'> is equivalent to:
    shift => '$class',
  }
 
+C<'classmethod_strict'> is like C<'classmethod'> but with
+C<< check_argument_count => 1 >>.
+
 =head2 Syntax and generated code
 
 Normally, Perl subroutines are not in scope in their own body, meaning the
@@ -458,6 +474,7 @@ And the generated code:
    # vvv   only if check_argument_count is enabled    vvv
    Carp::croak "Not enough arguments for fun (anon)" if @_ < 2;
    Carp::croak "Too many arguments for fun (anon)" if @_ > 2;
+   # ^^^                                              ^^^
    my ($p, $q) = @_;
    ...
  };
diff --git a/t/imports.t b/t/imports.t
index 526f64b..302ca69 100644
--- a/t/imports.t
+++ b/t/imports.t
@@ -1,6 +1,6 @@
 #!perl
 
-use Test::More tests => 25;
+use Test::More tests => 48;
 
 use warnings FATAL => 'all';
 use strict;
@@ -18,7 +18,7 @@ use strict;
 	is eval('fun foo :() {}; 1'), undef;
 	like $@, qr/syntax error/;
 
-	pound foo_1($x) { $x }
+	pound foo_1($x, $u) { $x }
 	is foo_1(2 + 2), 4;
 
 	no Function::Parameters qw(pound);
@@ -33,7 +33,7 @@ use strict;
 	is eval('fun foo () {}; 1'), undef;
 	like $@, qr/syntax error/;
 
-	pound foo_2() { $self }
+	pound foo_2($u) { $self }
 	is foo_2(2 + 2), 4;
 
 	no Function::Parameters qw(pound);
@@ -51,7 +51,7 @@ use strict;
 	is eval('fun foo () {}; 1'), undef;
 	like $@, qr/syntax error/;
 
-	pound foo_3() { $class }
+	pound foo_3($u) { $class }
 	is foo_3(2 + 2), 4;
 
 	no Function::Parameters;
@@ -60,6 +60,63 @@ use strict;
 	like $@, qr/syntax error/;
 }
 
+{
+	use Function::Parameters { pound => 'function_strict' };
+
+	is eval('fun foo :() {}; 1'), undef;
+	like $@, qr/syntax error/;
+
+	pound foo_4($x) { $x }
+	is foo_4(2 + 2), 4;
+
+	is eval('foo_4(5, 6)'), undef;
+	like $@, qr/Too many arguments/;
+
+	no Function::Parameters qw(pound);
+
+	is eval('pound foo() {}; 1'), undef;
+	like $@, qr/syntax error/;
+}
+
+{
+	use Function::Parameters { pound => 'method_strict' };
+
+	is eval('fun foo () {}; 1'), undef;
+	like $@, qr/syntax error/;
+
+	pound foo_5() { $self }
+	is foo_5(2 + 2), 4;
+
+	is eval('foo_5(5, 6)'), undef;
+	like $@, qr/Too many arguments/;
+
+	no Function::Parameters qw(pound);
+
+	is eval('pound unfoo :() {}; 1'), undef;
+	like $@, qr/syntax error/;
+}
+
+{
+	is eval('pound unfoo( ){}; 1'), undef;
+	like $@, qr/syntax error/;
+
+	use Function::Parameters { pound => 'classmethod_strict' };
+
+	is eval('fun foo () {}; 1'), undef;
+	like $@, qr/syntax error/;
+
+	pound foo_6() { $class }
+	is foo_6(2 + 2), 4;
+
+	is eval('foo_6(5, 6)'), undef;
+	like $@, qr/Too many arguments/;
+
+	no Function::Parameters;
+
+	is eval('pound unfoo :lvalue{}; 1'), undef;
+	like $@, qr/syntax error/;
+}
+
 is eval('Function::Parameters->import(":QQQQ"); 1'), undef;
 like $@, qr/valid identifier/;