view release on metacpan or  search on metacpan

Parameters.xs  view on Meta::CPAN

    /* 7, 8 */ {
        if (ps->slurpy.name) {
            PUSHs(ps->slurpy.name);
            if (ps->slurpy.type) {
                PUSHs(ps->slurpy.type);
            } else {
                PUSHmortal;
            }
        } else {
            PUSHmortal;
            PUSHmortal;
        }
    }
    PUTBACK;

    call_pv(MY_PKG "::_register_info", G_VOID);

    FREETMPS;
    LEAVE;
}

static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) {
    ParamSpec *param_spec;
    SV *declarator;
    I32 floor_ix;
    int save_ix;
    SV *saw_name;
    OpGuard *prelude_sentinel;
    SV *proto;
    OpGuard *attrs_sentinel;
    OP *body;
    unsigned builtin_attrs;
    I32 c;

    declarator = sentinel_mortalize(sen, newSVpvn(keyword_ptr, keyword_len));
    if (lex_bufutf8()) {
        SvUTF8_on(declarator);
    }

    lex_read_space(0);

    builtin_attrs = 0;

    /* function name */
    saw_name = NULL;
    if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ sen, TRUE))) {

        if (PL_parser->expect != XSTATE) {
            /* bail out early so we don't predeclare $saw_name */
            Perl_croak(aTHX_ "In %"SVf": I was expecting a parameter list, not \"%"SVf"\"", SVfARG(declarator), SVfARG(saw_name));
        }

        sv_catpvs(declarator, " ");
        sv_catsv(declarator, saw_name);

        if (
            sv_eq_pvs(saw_name, "BEGIN") ||
            sv_eq_pvs(saw_name, "END") ||
            sv_eq_pvs(saw_name, "INIT") ||
            sv_eq_pvs(saw_name, "CHECK") ||
            sv_eq_pvs(saw_name, "UNITCHECK")
        ) {
            builtin_attrs |= MY_ATTR_SPECIAL;
        }

        lex_read_space(0);
    } else if (!(spec->flags & FLAG_ANON_OK)) {
        Perl_croak(aTHX_ "I was expecting a function name, not \"%.*s\"", (int)(PL_parser->bufend - PL_parser->bufptr), PL_parser->bufptr);
    } else {
        sv_catpvs(declarator, " (anon)");
    }

    /* we're a subroutine declaration */
    floor_ix = start_subparse(FALSE, saw_name ? 0 : CVf_ANON);
    SAVEFREESV(PL_compcv);

    /* create outer block: '{' */
    save_ix = block_start(TRUE);

    /* initialize synthetic optree */
    Newx(prelude_sentinel, 1, OpGuard);
    op_guard_init(prelude_sentinel);
    sentinel_register(sen, prelude_sentinel, free_op_guard_void);

    /* parameters */
    c = lex_peek_unichar(0);
    if (c != '(') {
        Perl_croak(aTHX_ "In %"SVf": I was expecting a parameter list, not \"%c\"", SVfARG(declarator), (int)c);
    }

    lex_read_unichar(0);
    lex_read_space(0);

    Newx(param_spec, 1, ParamSpec);
    ps_init(param_spec);
    sentinel_register(sen, param_spec, ps_free_void);

    {
        OpGuard *init_sentinel;

        Newx(init_sentinel, 1, OpGuard);
        op_guard_init(init_sentinel);
        sentinel_register(sen, init_sentinel, free_op_guard_void);

        while ((c = lex_peek_unichar(0)) != ')') {
            int flags;
            SV *name, *type;
            char sigil;
            PADOFFSET padoff;

            padoff = parse_param(aTHX_ sen, declarator, spec, param_spec, &flags, &name, init_sentinel, &type);

            if (padoff != NOT_IN_PAD) {
                intro_my();
            }

            sigil = SvPV_nolen(name)[0];

            /* internal consistency */
            if (flags & PARAM_NAMED) {
                if (padoff == NOT_IN_PAD) {