From: Lukas Mai <l.mai@web.de>
Date: Sun, 24 Jun 2012 10:32:22 +0000 (+0200)
Subject: allow parameters to be referenced from defaults in the same param list
X-Git-Tag: v0.06_01~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1e0f159585d5f011817e4001f72df4b052191932;p=p5sagit%2FFunction-Parameters.git

allow parameters to be referenced from defaults in the same param list
---

diff --git a/Parameters.xs b/Parameters.xs
index 8e91f76..1a4e58e 100644
--- a/Parameters.xs
+++ b/Parameters.xs
@@ -221,6 +221,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 	I32 floor_ix;
 	int save_ix;
 	SV *saw_name;
+	OP **prelude_sentinel;
 	AV *params;
 	DefaultParamSpec *defaults;
 	int args_min, args_max;
@@ -276,12 +277,27 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 	/* create outer block: '{' */
 	save_ix = S_block_start(aTHX_ TRUE);
 
+	/* initialize synthetic optree */
+	Newx(prelude_sentinel, 1, OP *);
+	*prelude_sentinel = NULL;
+	SAVEDESTRUCTOR_X(free_ptr_op, prelude_sentinel);
+
 	/* parameters */
 	params = NULL;
 	defaults = NULL;
 	args_min = 0;
 	args_max = -1;
 
+	/* my $self; */
+	if (SvTRUE(spec->shift)) {
+		OP *var;
+
+		var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8));
+		var->op_targ = pad_add_name_sv(spec->shift, 0, NULL, NULL);
+
+		*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
+	}
+
 	c = lex_peek_unichar(0);
 	if (c == '(') {
 		DefaultParamSpec **pdefaults_tail = &defaults;
@@ -356,6 +372,16 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 					c = lex_peek_unichar(0);
 				}
 
+				/* my $param; */
+				{
+					OP *var;
+
+					var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8));
+					var->op_targ = pad_add_name_sv(param, 0, NULL, NULL);
+
+					*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
+				}
+
 				if (c == ',') {
 					lex_read_unichar(0);
 					lex_read_space(0);
@@ -485,7 +511,6 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 		);
 	}
 
-
 	if (builtin_attrs & MY_ATTR_LVALUE) {
 		CvLVALUE_on(PL_compcv);
 	}
@@ -496,141 +521,132 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 		CvSPECIAL_on(PL_compcv);
 	}
 
-	/* munge */
-	{
-		OP **prelude_sentinel = NULL;
-
-		Newx(prelude_sentinel, 1, OP *);
-		*prelude_sentinel = NULL;
-		SAVEDESTRUCTOR_X(free_ptr_op, prelude_sentinel);
-
-		/* min/max argument count checks */
-		if (spec->flags & FLAG_CHECK_NARGS) {
-			if (SvTRUE(spec->shift)) {
-				args_min++;
-				if (args_max != -1) {
-					args_max++;
-				}
+	/* min/max argument count checks */
+	if (spec->flags & FLAG_CHECK_NARGS) {
+		if (SvTRUE(spec->shift)) {
+			args_min++;
+			if (args_max != -1) {
+				args_max++;
 			}
+		}
 
-			if (args_min > 0) {
-				OP *chk, *cond, *err, *croak;
+		if (args_min > 0) {
+			OP *chk, *cond, *err, *croak;
 
-				err = newSVOP(OP_CONST, 0,
-				              newSVpvf("Not enough arguments for %"SVf, SVfARG(declarator)));
+			err = newSVOP(OP_CONST, 0,
+				          newSVpvf("Not enough arguments for %"SVf, SVfARG(declarator)));
 
-				croak = newCVREF(OPf_WANT_SCALAR,
-				                 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
-				err = newUNOP(OP_ENTERSUB, OPf_STACKED,
-				              op_append_elem(OP_LIST, err, croak));
+			croak = newCVREF(OPf_WANT_SCALAR,
+				             newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
+			err = newUNOP(OP_ENTERSUB, OPf_STACKED,
+				          op_append_elem(OP_LIST, err, croak));
 
-				cond = newBINOP(OP_LT, 0,
-				                newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
-				                newSVOP(OP_CONST, 0, newSViv(args_min)));
-				chk = newLOGOP(OP_AND, 0, cond, err);
+			cond = newBINOP(OP_LT, 0,
+				            newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
+				            newSVOP(OP_CONST, 0, newSViv(args_min)));
+			chk = newLOGOP(OP_AND, 0, cond, err);
 
-				*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
-			}
-			if (args_max != -1) {
-				OP *chk, *cond, *err, *croak;
+			*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
+		}
+		if (args_max != -1) {
+			OP *chk, *cond, *err, *croak;
 
-				err = newSVOP(OP_CONST, 0,
-				              newSVpvf("Too many arguments for %"SVf, SVfARG(declarator)));
+			err = newSVOP(OP_CONST, 0,
+				          newSVpvf("Too many arguments for %"SVf, SVfARG(declarator)));
 
-				croak = newCVREF(OPf_WANT_SCALAR,
-				                 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
-				err = newUNOP(OP_ENTERSUB, OPf_STACKED,
-				              op_append_elem(OP_LIST, err, croak));
+			croak = newCVREF(OPf_WANT_SCALAR,
+				             newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
+			err = newUNOP(OP_ENTERSUB, OPf_STACKED,
+				          op_append_elem(OP_LIST, err, croak));
 
-				cond = newBINOP(OP_GT, 0,
-				                newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
-				                newSVOP(OP_CONST, 0, newSViv(args_max)));
-				chk = newLOGOP(OP_AND, 0, cond, err);
+			cond = newBINOP(OP_GT, 0,
+				            newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
+				            newSVOP(OP_CONST, 0, newSViv(args_max)));
+			chk = newLOGOP(OP_AND, 0, cond, err);
 
-				*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
-			}
+			*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
 		}
+	}
 
-		/* my $self = shift; */
-		if (SvTRUE(spec->shift)) {
-			OP *var, *shift;
-
-			var = newOP(OP_PADSV, OPf_WANT_SCALAR | (OPpLVAL_INTRO << 8));
-			var->op_targ = pad_add_name_sv(spec->shift, 0, NULL, NULL);
-
-			shift = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
-			*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, shift));
-		}
+	/* $self = shift; */
+	if (SvTRUE(spec->shift)) {
+		OP *var, *shift;
 
-		/* my (PARAMS) = @_; */
-		if (params && av_len(params) > -1) {
-			SV *param;
-			OP *init_param, *left, *right;
-
-			left = NULL;
-			while ((param = av_shift(params)) != &PL_sv_undef) {
-				OP *const var = newOP(OP_PADSV, OPf_WANT_LIST | (OPpLVAL_INTRO << 8));
-				var->op_targ = pad_add_name_sv(param, 0, NULL, NULL);
-				SvREFCNT_dec(param);
-				left = op_append_elem(OP_LIST, left, var);
-			}
+		var = newOP(OP_PADSV, OPf_WANT_SCALAR);
+		var->op_targ = pad_findmy_sv(spec->shift, 0);
 
-			left->op_flags |= OPf_PARENS;
-			right = newAVREF(newGVOP(OP_GV, 0, PL_defgv));
-			init_param = newASSIGNOP(OPf_STACKED, left, 0, right);
-			init_param = newSTATEOP(0, NULL, init_param);
+		shift = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
+		*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, shift));
+	}
 
-			*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, init_param);
+	/* (PARAMS) = @_; */
+	if (params && av_len(params) > -1) {
+		SV *param;
+		OP *init_param, *left, *right;
+
+		left = NULL;
+		while ((param = av_shift(params)) != &PL_sv_undef) {
+			OP *const var = newOP(OP_PADSV, OPf_WANT_LIST);
+			var->op_targ = pad_findmy_sv(param, 0);
+			SvREFCNT_dec(param);
+			left = op_append_elem(OP_LIST, left, var);
 		}
 
-		/* defaults */
-		{
-			OP *gen = NULL;
-			DefaultParamSpec *dp;
+		left->op_flags |= OPf_PARENS;
+		right = newAVREF(newGVOP(OP_GV, 0, PL_defgv));
+		init_param = newASSIGNOP(OPf_STACKED, left, 0, right);
+		init_param = newSTATEOP(0, NULL, init_param);
 
-			for (dp = defaults; dp; dp = dp->next) {
-				OP *init = dp->init;
-				OP *var, *args, *cond;
+		*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, init_param);
+	}
 
-				/* var = `$,name */
-				var = newOP(OP_PADSV, 0);
-				var->op_targ = pad_findmy_sv(dp->name, 0);
+	/* defaults */
+	{
+		OP *gen = NULL;
+		DefaultParamSpec *dp;
 
-				/* init = `,var = ,init */
-				init = newASSIGNOP(OPf_STACKED, var, 0, init);
+		for (dp = defaults; dp; dp = dp->next) {
+			OP *init = dp->init;
+			OP *var, *args, *cond;
 
-				/* args = `@_ */
-				args = newAVREF(newGVOP(OP_GV, 0, PL_defgv));
+			/* var = `$,name */
+			var = newOP(OP_PADSV, 0);
+			var->op_targ = pad_findmy_sv(dp->name, 0);
 
-				/* cond = `,args < ,index */
-				cond = newBINOP(OP_LT, 0, args, newSVOP(OP_CONST, 0, newSViv(dp->limit)));
+			/* init = `,var = ,init */
+			init = newASSIGNOP(OPf_STACKED, var, 0, init);
 
-				/* init = `,init if ,cond */
-				init = newLOGOP(OP_AND, 0, cond, init);
+			/* args = `@_ */
+			args = newAVREF(newGVOP(OP_GV, 0, PL_defgv));
 
-				/* gen = `,gen ; ,init */
-				gen = op_append_list(OP_LINESEQ, gen, newSTATEOP(0, NULL, init));
+			/* cond = `,args < ,index */
+			cond = newBINOP(OP_LT, 0, args, newSVOP(OP_CONST, 0, newSViv(dp->limit)));
 
-				dp->init = NULL;
-			}
+			/* init = `,init if ,cond */
+			init = newLOGOP(OP_AND, 0, cond, init);
 
-			*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, gen);
+			/* gen = `,gen ; ,init */
+			gen = op_append_list(OP_LINESEQ, gen, newSTATEOP(0, NULL, init));
+
+			dp->init = NULL;
 		}
 
-		/* finally let perl parse the actual subroutine body */
-		body = parse_block(0);
+		*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, gen);
+	}
 
-		/* add '();' to make function return nothing by default */
-		/* (otherwise the invisible parameter initialization can "leak" into
-		   the return value: fun ($x) {}->("asdf", 0) == 2) */
-		if (*prelude_sentinel) {
-			body = newSTATEOP(0, NULL, body);
-		}
+	/* finally let perl parse the actual subroutine body */
+	body = parse_block(0);
 
-		body = op_append_list(OP_LINESEQ, *prelude_sentinel, body);
-		*prelude_sentinel = NULL;
+	/* add '();' to make function return nothing by default */
+	/* (otherwise the invisible parameter initialization can "leak" into
+	   the return value: fun ($x) {}->("asdf", 0) == 2) */
+	if (*prelude_sentinel) {
+		body = newSTATEOP(0, NULL, body);
 	}
 
+	body = op_append_list(OP_LINESEQ, *prelude_sentinel, body);
+	*prelude_sentinel = NULL;
+
 	/* it's go time. */
 	{
 		OP *const attrs = *attrs_sentinel;
diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm
index 1eeae05..ca7acc0 100644
--- a/lib/Function/Parameters.pm
+++ b/lib/Function/Parameters.pm
@@ -343,18 +343,15 @@ turns into
    ...
  }
 
-except that none of the parameters are in scope in the expressions that specify
-default values. Thus:
+You can even refer to previous parameters in the same parameter list:
 
-  my $var = "outer";
+ print fun ($x, $y = $x + 1) { "$x and $y" }->(9);  # "9 and 10"
 
-  fun foo($var, $wat = $var) {
-    # $wat will default to "outer", not to what was passed
-    # as the first argument!
-    ...
-  }
+This also works with the implicit first parameter of methods:
 
-This may change in a future version of this module.
+ method scale($factor = $self->default_factor) {
+   $self->{amount} *= $factor;
+ }
 
 =item C<check_argument_count>
 
diff --git a/t/defaults.t b/t/defaults.t
index dcac440..fc771c3 100644
--- a/t/defaults.t
+++ b/t/defaults.t
@@ -1,6 +1,6 @@
 #!perl
 
-use Test::More tests => 38;
+use Test::More tests => 46;
 
 use warnings FATAL => 'all';
 use strict;
@@ -39,7 +39,7 @@ fun sharingan($input, $x = [], $y = {}) {
 	is_deeply [sharingan $sneaky], [[['thants']], {0 => ['thants']}];
 }
 
-is eval('fun ($x, $y = $x) {}'), undef;
+is eval('fun ($x, $y = $powersauce) {}'), undef;
 like $@, qr/^Global symbol.*explicit package name/;
 
 {
@@ -52,12 +52,12 @@ like $@, qr/^Global symbol.*explicit package name/;
 		}
 
 		is_deeply guy('a', 'b'), ['a', 'b'];
-		is_deeply guy('c'), ['c', 'herp2'];
+		is_deeply guy('c'), ['c', 'c2'];
 		is_deeply guy, ['herp', 'herp2'];
 
 		$d = 'ort';
 		is_deeply guy('a', 'b'), ['a', 'b'];
-		is_deeply guy('c'), ['c', 'ort2'];
+		is_deeply guy('c'), ['c', 'c2'];
 		is_deeply guy, ['ort', 'ort2'];
 
 		my $g = fun ($alarum = $d) { "[$alarum]" };
@@ -65,7 +65,7 @@ like $@, qr/^Global symbol.*explicit package name/;
 		is $g->(), "[ort]";
 
 		$d = 'flowerpot';
-		is_deeply guy('bloodstain'), ['bloodstain', 'flowerpot2'];
+		is_deeply guy('bloodstain'), ['bloodstain', 'bloodstain2'];
 		is $g->(), "[flowerpot]";
 
 		$f = $g;
@@ -102,3 +102,38 @@ like $@, qr/default value/;
 
 is eval('nofun ($x = 42) {}'), undef;
 like $@, qr/nofun.*unexpected.*=.*parameter/;
+
+
+{
+	my $var = "outer";
+
+	fun scope_check(
+		$var,  # inner
+		$snd = "${var}2",  # initialized from $var)
+		$both = "$var and $snd",
+	) {
+		return $var, $snd, $both;
+	}
+
+	is_deeply [scope_check 'A'],      ['A', 'A2', 'A and A2'];
+	is_deeply [scope_check 'B', 'C'], ['B', 'C', 'B and C'];
+	is_deeply [scope_check 4, 5, 6],  [4, 5, 6];
+
+	is eval('fun ($QQQ = $QQQ) {}; 1'), undef;
+	like $@, qr/Global symbol.*\$QQQ.*explicit package name/;
+
+
+	use Function::Parameters { method => 'method' };
+
+	method mscope_check(
+		$var,  # inner
+		$snd = "${var}2",  # initialized from $var
+		$both = "($self) $var and $snd",  # and $self!
+	) {
+		return $self, $var, $snd, $both;
+	}
+
+	is_deeply [mscope_check '$x', 'A'],      ['$x', 'A', 'A2', '($x) A and A2'];
+	is_deeply [mscope_check '$x', 'B', 'C'], ['$x', 'B', 'C', '($x) B and C'];
+	is_deeply [mscope_check '$x', 4, 5, 6],  ['$x', 4, 5, 6];
+}