X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Parameters.xs;h=2031f0b5add9706e71001ffab9a95e8482f1d427;hb=d8e5d54068b89a5b18cfd3a38c8c9f38a1c54df1;hp=1dda3ad42ae5975679355ee9e01e4373fc3a6a6a;hpb=63915d2641ec4983bb6b54e1ff7d30cd0032c40d;p=p5sagit%2FFunction-Parameters.git diff --git a/Parameters.xs b/Parameters.xs index 1dda3ad..2031f0b 100644 --- a/Parameters.xs +++ b/Parameters.xs @@ -83,7 +83,8 @@ enum { FLAG_NAME_OK = 0x01, FLAG_ANON_OK = 0x02, FLAG_DEFAULT_ARGS = 0x04, - FLAG_CHECK_NARGS = 0x08 + FLAG_CHECK_NARGS = 0x08, + FLAG_INVOCANT = 0x10 }; DEFSTRUCT(KWSpec) { @@ -156,9 +157,6 @@ static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, KWSpec *spec) { } -#include "toke_on_crack.c.inc" - - static void free_defspec(pTHX_ void *vp) { DefaultParamSpec *dp = vp; op_free(dp->init); @@ -216,11 +214,237 @@ enum { MY_ATTR_SPECIAL = 0x04 }; +static void my_sv_cat_c(pTHX_ SV *sv, U32 c) { + char ds[UTF8_MAXBYTES + 1], *d; + d = uvchr_to_utf8(ds, c); + if (d - ds > 1) { + sv_utf8_upgrade(sv); + } + sv_catpvn(sv, ds, d - ds); +} + +static bool my_is_uni_xidfirst(pTHX_ UV c) { + U8 tmpbuf[UTF8_MAXBYTES + 1]; + uvchr_to_utf8(tmpbuf, c); + return is_utf8_xidfirst(tmpbuf); +} + +static bool my_is_uni_xidcont(pTHX_ UV c) { + U8 tmpbuf[UTF8_MAXBYTES + 1]; + uvchr_to_utf8(tmpbuf, c); + return is_utf8_xidcont(tmpbuf); +} + +static SV *my_scan_word(pTHX_ bool allow_package) { + bool at_start, at_substart; + I32 c; + SV *sv = sv_2mortal(newSVpvs("")); + if (lex_bufutf8()) { + SvUTF8_on(sv); + } + + at_start = at_substart = TRUE; + c = lex_peek_unichar(0); + + while (c != -1) { + if (at_substart ? my_is_uni_xidfirst(aTHX_ c) : my_is_uni_xidcont(aTHX_ c)) { + lex_read_unichar(0); + my_sv_cat_c(aTHX_ sv, c); + at_substart = FALSE; + c = lex_peek_unichar(0); + } else if (allow_package && !at_substart && c == '\'') { + lex_read_unichar(0); + c = lex_peek_unichar(0); + if (!my_is_uni_xidfirst(aTHX_ c)) { + lex_stuff_pvs("'", 0); + break; + } + sv_catpvs(sv, "'"); + at_substart = TRUE; + } else if (allow_package && (at_start || !at_substart) && c == ':') { + lex_read_unichar(0); + if (lex_peek_unichar(0) != ':') { + lex_stuff_pvs(":", 0); + break; + } + lex_read_unichar(0); + c = lex_peek_unichar(0); + if (!my_is_uni_xidfirst(aTHX_ c)) { + lex_stuff_pvs("::", 0); + break; + } + sv_catpvs(sv, "::"); + at_substart = TRUE; + } else { + break; + } + at_start = FALSE; + } + + return SvCUR(sv) ? sv : NULL; +} + +static SV *my_scan_parens_tail(pTHX_ bool keep_backslash) { + I32 c, nesting; + SV *sv; + line_t start; + + start = CopLINE(PL_curcop); + + sv = sv_2mortal(newSVpvs("")); + if (lex_bufutf8()) { + SvUTF8_on(sv); + } + + nesting = 0; + for (;;) { + c = lex_read_unichar(0); + if (c == EOF) { + CopLINE_set(PL_curcop, start); + return NULL; + } + + if (c == '\\') { + c = lex_read_unichar(0); + if (c == EOF) { + CopLINE_set(PL_curcop, start); + return NULL; + } + if (keep_backslash || (c != '(' && c != ')')) { + sv_catpvs(sv, "\\"); + } + } else if (c == '(') { + nesting++; + } else if (c == ')') { + if (!nesting) { + break; + } + nesting--; + } + + my_sv_cat_c(aTHX_ sv, c); + } + + return sv; +} + +static void my_check_prototype(pTHX_ const SV *declarator, SV *proto) { + char *start, *r, *w, *end; + STRLEN len; + + /* strip spaces */ + start = SvPV(proto, len); + end = start + len; + + for (w = r = start; r < end; r++) { + if (!isSPACE(*r)) { + *w++ = *r; + } + } + *w = '\0'; + SvCUR_set(proto, w - start); + end = w; + len = end - start; + + if (!ckWARN(WARN_ILLEGALPROTO)) { + return; + } + + /* check for bad characters */ + if (strspn(start, "$@%*;[]&\\_+") != len) { + SV *dsv = newSVpvs_flags("", SVs_TEMP); + warner( + packWARN(WARN_ILLEGALPROTO), + "Illegal character in prototype for %"SVf" : %s", + SVfARG(declarator), + SvUTF8(proto) + ? sv_uni_display( + dsv, + proto, + len, + UNI_DISPLAY_ISPRINT + ) + : pv_pretty(dsv, start, len, 60, NULL, NULL, + PERL_PV_ESCAPE_NONASCII + ) + ); + return; + } + + for (r = start; r < end; r++) { + switch (*r) { + default: + warner( + packWARN(WARN_ILLEGALPROTO), + "Illegal character in prototype for %"SVf" : %s", + SVfARG(declarator), r + ); + return; + + case '_': + if (r[1] && !strchr(";@%", *r)) { + warner( + packWARN(WARN_ILLEGALPROTO), + "Illegal character after '_' in prototype for %"SVf" : %s", + SVfARG(declarator), r + ); + return; + } + break; + + case '@': + case '%': + if (r[1]) { + warner( + packWARN(WARN_ILLEGALPROTO), + "prototype after '%c' for %"SVf": %s", + *r, SVfARG(declarator), r + 1 + ); + return; + } + break; + + case '\\': + r++; + if (strchr("$@%&*", *r)) { + break; + } + if (*r == '[') { + r++; + for (; r < end && *r != ']'; r++) { + if (!strchr("$@%&*", *r)) { + break; + } + } + if (*r == ']' && r[-1] != '[') { + break; + } + } + warner( + packWARN(WARN_ILLEGALPROTO), + "Illegal character after '\\' in prototype for %"SVf" : %s", + SVfARG(declarator), r + ); + return; + + case '$': + case '*': + case '&': + case ';': + case '+': + break; + } + } +} + static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) { SV *declarator; I32 floor_ix; int save_ix; SV *saw_name; + OP **prelude_sentinel; + int did_invocant_decl; + SV *invocant; AV *params; DefaultParamSpec *defaults; int args_min, args_max; @@ -228,7 +452,6 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len OP **attrs_sentinel, *body; unsigned builtin_attrs; STRLEN len; - char *s; I32 c; declarator = sv_2mortal(newSVpvn(keyword_ptr, keyword_len)); @@ -239,9 +462,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len /* function name */ saw_name = NULL; - s = PL_parser->bufptr; - if ((spec->flags & FLAG_NAME_OK) && (len = S_scan_word(aTHX_ s, TRUE))) { - saw_name = sv_2mortal(newSVpvn_flags(s, len, PARSING_UTF ? SVf_UTF8 : 0)); + if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ TRUE))) { if (PL_parser->expect != XSTATE) { /* bail out early so we don't predeclare $saw_name */ @@ -261,10 +482,9 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len builtin_attrs |= MY_ATTR_SPECIAL; } - lex_read_to(s + len); lex_read_space(0); } else if (!(spec->flags & FLAG_ANON_OK)) { - croak("I was expecting a function name, not \"%.*s\"", (int)(PL_parser->bufend - s), s); + croak("I was expecting a function name, not \"%.*s\"", (int)(PL_parser->bufend - PL_parser->bufptr), PL_parser->bufptr); } else { sv_catpvs(declarator, " (anon)"); } @@ -276,7 +496,14 @@ 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 */ + did_invocant_decl = 0; + invocant = NULL; params = NULL; defaults = NULL; args_min = 0; @@ -306,11 +533,10 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len lex_read_unichar(0); lex_read_space(0); - s = PL_parser->bufptr; - if (!(len = S_scan_word(aTHX_ s, FALSE))) { + if (!(param = my_scan_word(aTHX_ FALSE))) { croak("In %"SVf": missing identifier", SVfARG(declarator)); } - param = sv_2mortal(newSVpvf("%c%.*s", sigil, (int)len, s)); + sv_insert(param, 0, 0, &sigil, 1); if (saw_slurpy) { croak("In %"SVf": I was expecting \")\" after \"%"SVf"\", not \"%"SVf"\"", SVfARG(declarator), SVfARG(saw_slurpy), SVfARG(param)); } @@ -320,40 +546,92 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len args_max = -1; saw_slurpy = param; } - av_push(params, SvREFCNT_inc_simple_NN(param)); - lex_read_to(s + len); - lex_read_space(0); + lex_read_space(0); c = lex_peek_unichar(0); - if (!(c == '=' && (spec->flags & FLAG_DEFAULT_ARGS))) { - if (sigil == '$' && !defaults) { - args_min++; + assert(param_count >= 1); + + if (c == ':') { + if (invocant) { + croak("In %"SVf": invalid double invocants %"SVf", %"SVf"", SVfARG(declarator), SVfARG(invocant), SVfARG(param)); + } + if (param_count != 1) { + croak("In %"SVf": invocant %"SVf" must be first in parameter list", SVfARG(declarator), SVfARG(param)); + } + if (!(spec->flags & FLAG_INVOCANT)) { + croak("In %"SVf": invocant %"SVf" not allowed here", SVfARG(declarator), SVfARG(param)); + } + if (sigil != '$') { + croak("In %"SVf": invocant %"SVf" can't be a %s", SVfARG(declarator), SVfARG(param), sigil == '@' ? "array" : "hash"); } - } else if (sigil != '$') { - croak("In %"SVf": %s %"SVf" can't have a default value", SVfARG(declarator), sigil == '@' ? "array" : "hash", SVfARG(saw_slurpy)); - } else { - DefaultParamSpec *curdef; lex_read_unichar(0); lex_read_space(0); - Newx(curdef, 1, DefaultParamSpec); - curdef->next = NULL; - curdef->limit = param_count; - curdef->name = param; - curdef->init = NULL; - SAVEDESTRUCTOR_X(free_defspec, curdef); + args_max--; + param_count--; + invocant = param; + } else { + av_push(params, SvREFCNT_inc_simple_NN(param)); + + if (c == '=' && (spec->flags & FLAG_DEFAULT_ARGS)) { + DefaultParamSpec *curdef; - curdef->next = *pdefaults_tail; - *pdefaults_tail = curdef; - pdefaults_tail = &curdef->next; + if (sigil != '$') { + croak("In %"SVf": %s %"SVf" can't have a default value", SVfARG(declarator), sigil == '@' ? "array" : "hash", SVfARG(saw_slurpy)); + } - /* let perl parse the default parameter value */ - curdef->init = parse_termexpr(0); + lex_read_unichar(0); + lex_read_space(0); - lex_read_space(0); - c = lex_peek_unichar(0); + /* my $self; # in scope for default argument */ + if (!invocant && !did_invocant_decl && 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)); + + did_invocant_decl = 1; + } + + Newx(curdef, 1, DefaultParamSpec); + curdef->next = NULL; + curdef->limit = param_count; + curdef->name = param; + curdef->init = NULL; + SAVEDESTRUCTOR_X(free_defspec, curdef); + + curdef->next = *pdefaults_tail; + *pdefaults_tail = curdef; + pdefaults_tail = &curdef->next; + + /* let perl parse the default parameter value */ + curdef->init = parse_termexpr(0); + + lex_read_space(0); + c = lex_peek_unichar(0); + } else { + if (sigil == '$' && !defaults) { + args_min++; + } + } + } + + /* 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 (param_count == 0) { + continue; } if (c == ',') { @@ -388,11 +666,11 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len lex_stuff_pvs(":", 0); c = ':'; } else { - proto = sv_2mortal(newSVpvs("")); - if (!S_scan_str(aTHX_ proto, FALSE, FALSE)) { + lex_read_unichar(0); + if (!(proto = my_scan_parens_tail(aTHX_ FALSE))) { croak("In %"SVf": prototype not terminated", SVfARG(declarator)); } - S_check_prototype(aTHX_ declarator, proto); + my_check_prototype(aTHX_ declarator, proto); lex_read_space(0); c = lex_peek_unichar(0); } @@ -419,14 +697,10 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len for (;;) { SV *attr; - s = PL_parser->bufptr; - if (!(len = S_scan_word(aTHX_ s, FALSE))) { + if (!(attr = my_scan_word(aTHX_ FALSE))) { break; } - attr = sv_2mortal(newSVpvn_flags(s, len, PARSING_UTF ? SVf_UTF8 : 0)); - - lex_read_to(s + len); lex_read_space(0); c = lex_peek_unichar(0); @@ -439,11 +713,14 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len attr = NULL; } } else { - SV *sv = sv_2mortal(newSVpvs("")); - if (!S_scan_str(aTHX_ sv, TRUE, TRUE)) { + SV *sv; + lex_read_unichar(0); + if (!(sv = my_scan_parens_tail(aTHX_ TRUE))) { croak("In %"SVf": unterminated attribute parameter in attribute list", SVfARG(declarator)); } + sv_catpvs(attr, "("); sv_catsv(attr, sv); + sv_catpvs(attr, ")"); lex_read_space(0); c = lex_peek_unichar(0); @@ -485,7 +762,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,127 +772,146 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len CvSPECIAL_on(PL_compcv); } - /* munge */ - { - OP *prelude = NULL; + if (!invocant) { + invocant = spec->shift; + + /* my $self; # wasn't needed yet */ + if (SvTRUE(invocant) && !did_invocant_decl) { + OP *var; - /* my $self = shift; */ - if (SvTRUE(spec->shift)) { - OP *const var = newOP(OP_PADSV, OPf_WANT_SCALAR | (OPpLVAL_INTRO << 8)); - var->op_targ = pad_add_name_sv(spec->shift, 0, NULL, NULL); + var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8)); + var->op_targ = pad_add_name_sv(invocant, 0, NULL, NULL); - prelude = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0)); - prelude = newSTATEOP(0, NULL, prelude); + *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var)); + } + } + + /* min/max argument count checks */ + if (spec->flags & FLAG_CHECK_NARGS) { + if (SvTRUE(invocant)) { + args_min++; + if (args_max != -1) { + args_max++; + } } - /* min/max argument count checks */ - if (spec->flags & FLAG_CHECK_NARGS) { - 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 = op_append_list(OP_LINESEQ, prelude, 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 = op_append_list(OP_LINESEQ, prelude, newSTATEOP(0, NULL, chk)); - } + *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk)); } + } - /* 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); - } + /* $self = shift; */ + if (SvTRUE(invocant)) { + OP *var, *shift; + + var = newOP(OP_PADSV, OPf_WANT_SCALAR); + var->op_targ = pad_findmy_sv(invocant, 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 = op_append_list(OP_LINESEQ, prelude, 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 = op_append_list(OP_LINESEQ, prelude, 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) { - body = newSTATEOP(0, NULL, body); - } + /* finally let perl parse the actual subroutine body */ + body = parse_block(0); - body = op_append_list(OP_LINESEQ, prelude, body); + /* 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; @@ -643,7 +938,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len attrs, body ); - *pop = NULL; + *pop = newOP(OP_NULL, 0); return KEYWORD_PLUGIN_STMT; } } @@ -674,14 +969,15 @@ BOOT: WARNINGS_ENABLE { HV *const stash = gv_stashpvs(MY_PKG, GV_ADD); /**/ - newCONSTSUB(stash, "FLAG_NAME_OK", newSViv(FLAG_NAME_OK)); - newCONSTSUB(stash, "FLAG_ANON_OK", newSViv(FLAG_ANON_OK)); + newCONSTSUB(stash, "FLAG_NAME_OK", newSViv(FLAG_NAME_OK)); + newCONSTSUB(stash, "FLAG_ANON_OK", newSViv(FLAG_ANON_OK)); newCONSTSUB(stash, "FLAG_DEFAULT_ARGS", newSViv(FLAG_DEFAULT_ARGS)); - newCONSTSUB(stash, "FLAG_CHECK_NARGS", newSViv(FLAG_CHECK_NARGS)); + newCONSTSUB(stash, "FLAG_CHECK_NARGS", newSViv(FLAG_CHECK_NARGS)); + newCONSTSUB(stash, "FLAG_INVOCANT", newSViv(FLAG_INVOCANT)); newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS)); - newCONSTSUB(stash, "HINTK_FLAGS_", newSVpvs(HINTK_FLAGS_)); - newCONSTSUB(stash, "HINTK_SHIFT_", newSVpvs(HINTK_SHIFT_)); - newCONSTSUB(stash, "HINTK_ATTRS_", newSVpvs(HINTK_ATTRS_)); + newCONSTSUB(stash, "HINTK_FLAGS_", newSVpvs(HINTK_FLAGS_)); + newCONSTSUB(stash, "HINTK_SHIFT_", newSVpvs(HINTK_SHIFT_)); + newCONSTSUB(stash, "HINTK_ATTRS_", newSVpvs(HINTK_ATTRS_)); /**/ next_keyword_plugin = PL_keyword_plugin; PL_keyword_plugin = my_keyword_plugin;