view release on metacpan or  search on metacpan

gv.c  view on Meta::CPAN

            if ( proto_utf8 ) SvUTF8_on(MUTABLE_SV(cv));
        }
    }
}

STATIC void
S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type)
{
    PERL_ARGS_ASSERT_GV_INIT_SVTYPE;

    switch (sv_type) {
    case SVt_PVIO:
        (void)GvIOn(gv);
        break;
    case SVt_PVAV:
        (void)GvAVn(gv);
        break;
    case SVt_PVHV:
        (void)GvHVn(gv);
        break;
#ifdef PERL_DONT_CREATE_GVSV
    case SVt_NULL:
    case SVt_PVCV:
    case SVt_PVFM:
    case SVt_PVGV:
        break;
    default:
        if(GvSVn(gv)) {
            /* Work round what appears to be a bug in Sun C++ 5.8 2005/10/13
               If we just cast GvSVn(gv) to void, it ignores evaluating it for
               its side effect */
        }
#endif
    }
}

static void core_xsub(pTHX_ CV* cv);

static GV *
S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
                          const char * const name, const STRLEN len)
{
    const int code = keyword(name, len, 1);
    static const char file[] = __FILE__;
    CV *cv, *oldcompcv = NULL;
    int opnum = 0;
    bool ampable = TRUE; /* &{}-able */
    COP *oldcurcop = NULL;
    yy_parser *oldparser = NULL;
    I32 oldsavestack_ix = 0;

    assert(gv || stash);
    assert(name);

    if (!code) return NULL; /* Not a keyword */
    switch (code < 0 ? -code : code) {
     /* no support for \&CORE::infix;
        no support for funcs that do not parse like funcs */
    case KEY___DATA__: case KEY___END__ :
    case KEY_ADJUST  : case KEY_AUTOLOAD: case KEY_BEGIN : case KEY_CHECK :
    case KEY_DESTROY : case KEY_END     : case KEY_INIT  : case KEY_UNITCHECK:
    case KEY_all     : case KEY_and     : case KEY_any   :
    case KEY_catch   : case KEY_class   :
    case KEY_cmp     : case KEY_default : case KEY_defer :
    case KEY_do      : case KEY_dump   : case KEY_else  : case KEY_elsif  :
    case KEY_eq     : case KEY_eval  : case KEY_field  :
    case KEY_finally:
    case KEY_for     : case KEY_foreach: case KEY_format: case KEY_ge     :
    case KEY_given   : case KEY_goto   : case KEY_grep  : case KEY_gt     :
    case KEY_if      : case KEY_isa    : 
    case KEY_last   :
    case KEY_le      : case KEY_local  : case KEY_lt    : case KEY_m      :
    case KEY_map     : case KEY_method : case KEY_my    :
    case KEY_ne   : case KEY_next : case KEY_no: case KEY_or: case KEY_our:
    case KEY_package: case KEY_print: case KEY_printf:
    case KEY_q    : case KEY_qq   : case KEY_qr     : case KEY_qw    :
    case KEY_qx   : case KEY_redo : case KEY_require: case KEY_return:
    case KEY_s    : case KEY_say  : case KEY_sort   :
    case KEY_state: case KEY_sub  :
    case KEY_tr   : case KEY_try  :
    case KEY_unless:
    case KEY_until: case KEY_use  : case KEY_when     : case KEY_while :
    case KEY_x    : case KEY_xor  : case KEY_y        :
        return NULL;
    case KEY_chomp: case KEY_chop: case KEY_defined: case KEY_delete:
    case KEY_eof  : case KEY_exec: case KEY_exists :
    case KEY_lstat:
    case KEY_split:
    case KEY_stat:
    case KEY_system:
    case KEY_truncate: case KEY_unlink:
        ampable = FALSE;
    }
    if (!gv) {
        gv = (GV *)newSV_type(SVt_NULL);
        gv_init(gv, stash, name, len, TRUE);
    }
    GvMULTI_on(gv);
    if (ampable) {
        ENTER;
        oldcurcop = PL_curcop;
        oldparser = PL_parser;
        lex_start(NULL, NULL, 0);
        oldcompcv = PL_compcv;
        PL_compcv = NULL; /* Prevent start_subparse from setting
                             CvOUTSIDE. */
        oldsavestack_ix = start_subparse(FALSE,0);
        cv = PL_compcv;
    }
    else {
        /* Avoid calling newXS, as it calls us, and things start to
           get hairy. */
        cv = MUTABLE_CV(newSV_type(SVt_PVCV));
        GvCV_set(gv,cv);
        GvCVGEN(gv) = 0;
        CvISXSUB_on(cv);
        CvXSUB(cv) = core_xsub;
        PoisonPADLIST(cv);
    }
    CvGV_set(cv, gv); /* This stops new ATTRSUB from setting CvFILE
                         from PL_curcop. */