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

diff --git a/Parameters.xs b/Parameters.xs
index 8e91f76..1a4e58e 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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];
+}