From: Lukas Mai <l.mai@web.de>
Date: Tue, 30 Oct 2012 19:55:41 +0000 (+0100)
Subject: fix scoping of named parameters
X-Git-Tag: v1.00~4^2~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FFunction-Parameters.git;a=commitdiff_plain;h=c56c77b63484ad166c526cbf4d65f6a54d394b24

fix scoping of named parameters
---

diff --git a/Parameters.xs b/Parameters.xs
index bf5192f..784d96b 100644
--- a/Parameters.xs
+++ b/Parameters.xs
@@ -1283,7 +1283,37 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 			OP *nameblock;
 			PADOFFSET vb, vc, vi, vk;
 			int vb_is_str, vc_is_str;
-			const size_t pos = count_positional_params(param_spec);
+
+			{
+				OP *lhs;
+				size_t i, lim;
+
+				lhs = NULL;
+
+				for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
+					OP *const var = my_var(
+						aTHX_
+						OPf_MOD | OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
+						param_spec->named_required.data[i].padoff
+					);
+					lhs = op_append_elem(OP_LIST, lhs, var);
+				}
+
+				for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
+					OP *const var = my_var(
+						aTHX_
+						OPf_MOD | OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
+						param_spec->named_optional.data[i].param.padoff
+					);
+					lhs = op_append_elem(OP_LIST, lhs, var);
+				}
+
+				lhs->op_flags |= OPf_PARENS;
+				*prelude_sentinel = op_append_list(
+					OP_LINESEQ, *prelude_sentinel,
+					lhs
+				);
+			}
 
 			nameblock = NULL;
 			nameblock_ix = S_block_start(aTHX_ TRUE);
@@ -1319,7 +1349,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 
 				var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8));
 				var->op_targ = vi = pad_add_name_pvs("$__I", 0, NULL, NULL);
-				var = newASSIGNOP(OPf_STACKED, var, 0, newSVOP(OP_CONST, 0, newSViv(pos)));
+				var = newASSIGNOP(OPf_STACKED, var, 0, newSVOP(OP_CONST, 0, newSViv(count_positional_params(param_spec))));
 				decl = op_append_list(OP_LINESEQ, decl, newSTATEOP(0, NULL, var));
 
 				//S_intro_my(aTHX);
diff --git a/t/recursion.t b/t/recursion.t
new file mode 100644
index 0000000..f9d5750
--- /dev/null
+++ b/t/recursion.t
@@ -0,0 +1,95 @@
+#!perl
+use warnings FATAL => 'all';
+use strict;
+
+use Test::More tests => 26;
+
+use Function::Parameters qw(:strict);
+
+fun foo_r($depth, $fst, $snd) {
+	return [$fst, $snd, $snd - $fst] if $depth <= 0;
+	$fst++;
+	my $thd = foo_r $depth - 1, $fst + $snd, $fst * $snd;
+	$snd++;
+	return [$fst, $snd, $thd];
+}
+
+fun foo_o($depth, $fst = 1, $snd = 2) {
+	return [$fst, $snd, $snd - $fst] if $depth <= 0;
+	$fst++;
+	my $thd = foo_o $depth - 1, $fst + $snd, $fst * $snd;
+	$snd++;
+	return [$fst, $snd, $thd];
+}
+
+fun foo_nr(:$depth, :$fst, :$snd) {
+	return [$fst, $snd, $snd - $fst] if $depth <= 0;
+	$fst++;
+	my $thd = foo_nr snd => $fst * $snd, depth => $depth - 1, fst => $fst + $snd;
+	$snd++;
+	return [$fst, $snd, $thd];
+}
+
+fun foo_no(:$depth, :$fst = 1, :$snd = 2) {
+	return [$fst, $snd, $snd - $fst] if $depth <= 0;
+	$fst++;
+	my $thd = foo_no snd => $fst * $snd, depth => $depth - 1, fst => $fst + $snd;
+	$snd++;
+	return [$fst, $snd, $thd];
+}
+
+for my $f (
+	\&foo_r, \&foo_o,
+	map { my $f = $_; fun ($d, $x, $y) { $f->(depth => $d, snd => $y, fst => $x) } }
+	\&foo_nr, \&foo_no
+) {
+	is_deeply $f->(0, 3, 5), [3, 5, 2];
+	is_deeply $f->(1, 3, 5), [4, 6, [9, 20, 11]];
+	is_deeply $f->(2, 3, 5), [4, 6, [10, 21, [30, 200, 170]]];
+}
+
+fun slurpy(:$n, %rest) { [$n, \%rest] }
+
+{
+	is_deeply slurpy(a => 1, b => 2, n => 9), [9, {a => 1, b => 2}];
+	my $sav1 = slurpy(n => 5);
+	is_deeply $sav1, [5, {}];
+	my $sav2 = slurpy(n => 6, a => 3);
+	is_deeply $sav2, [6, {a => 3}];
+	is_deeply $sav1, [5, {}];
+	is_deeply slurpy(b => 4, n => 7, hello => "world"), [7, {hello => "world", b => 4}];
+	is_deeply $sav1, [5, {}];
+	is_deeply $sav2, [6, {a => 3}];
+}
+
+{
+	{
+		package TimelyDestruction;
+
+		method new($class: $f) {
+			bless {on_destroy => $f}, $class
+		}
+
+		method DESTROY {
+			$self->{on_destroy}();
+		}
+	}
+
+	use Function::Parameters; # lax
+
+	fun bar(:$n) { defined $n ? $n + 1 : "nope" }
+
+	is bar(n => undef), "nope";
+	is bar(n => 2), 3;
+	is bar, "nope";
+
+	my $dead = 0;
+	{
+		my $o = TimelyDestruction->new(fun () { $dead++ });
+		is bar(n => $o), $o + 1, "this juice is bangin yo";
+	}
+	is $dead, 1;
+	$dead = 999;
+	is bar(n => 3), 4;
+	is $dead, 999;
+}