• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

C++ GvSTASH函数代码示例

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

本文整理汇总了C++中GvSTASH函数的典型用法代码示例。如果您正苦于以下问题:C++ GvSTASH函数的具体用法?C++ GvSTASH怎么用?C++ GvSTASH使用的例子?那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。



在下文中一共展示了GvSTASH函数的16个代码示例,这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞,您的评价将有助于我们的系统推荐出更棒的C++代码示例。

示例1: S_guess_stash

/* helper to return the stash for a svref, (Sv|Cv|Gv|GvE)STASH */
static HV*
S_guess_stash(pTHX_ SV* sv)
{
    if (SvOBJECT(sv)) {
	return SvSTASH(sv);
    }
    else {
	HV *stash = NULL;
	switch (SvTYPE(sv)) {
	case SVt_PVCV:
	    if (CvGV(sv) && isGV(CvGV(sv)) && GvSTASH(CvGV(sv)))
		return GvSTASH(CvGV(sv));
	    else if (/* !CvANON(sv) && */ CvSTASH(sv))
		return CvSTASH(sv);
	    break;
	case SVt_PVGV:
	    if (isGV_with_GP(sv) && GvGP(sv) && GvESTASH(MUTABLE_GV(sv)))
		return GvESTASH(MUTABLE_GV(sv));
	    break;
	default:
	    break;
	}
        return stash;
    }
}
开发者ID:bulk88,项目名称:cperl,代码行数:26,代码来源:xsutils.c


示例2: mop_get_code_info

int
mop_get_code_info (SV *coderef, char **pkg, char **name)
{
    if (!SvOK(coderef) || !SvROK(coderef) || SvTYPE(SvRV(coderef)) != SVt_PVCV) {
        return 0;
    }

    coderef = SvRV(coderef);

    /* sub is still being compiled */
    if (!CvGV(coderef)) {
        return 0;
    }

    /* I think this only gets triggered with a mangled coderef, but if
       we hit it without the guard, we segfault. The slightly odd return
       value strikes me as an improvement (mst)
    */

    if ( isGV_with_GP(CvGV(coderef)) ) {
        GV *gv   = CvGV(coderef);
        *pkg     = HvNAME( GvSTASH(gv) ? GvSTASH(gv) : CvSTASH(coderef) );
        *name    = GvNAME( CvGV(coderef) );
    } else {
        *pkg     = "__UNKNOWN__";
        *name    = "__ANON__";
    }

    return 1;
}
开发者ID:bobtfish,项目名称:class-mop,代码行数:30,代码来源:mop.c


示例3: Perl_gv_autoload4

GV*
Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
{
    char autoload[] = "AUTOLOAD";
    STRLEN autolen = sizeof(autoload)-1;
    GV* gv;
    CV* cv;
    HV* varstash;
    GV* vargv;
    SV* varsv;

    if (len == autolen && strnEQ(name, autoload, autolen))
	return Nullgv;
    if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
	return Nullgv;
    cv = GvCV(gv);

    if (!CvROOT(cv))
	return Nullgv;

    /*
     * Inheriting AUTOLOAD for non-methods works ... for now.
     */
    if (ckWARN(WARN_DEPRECATED) && !method &&
	(GvCVGEN(gv) || GvSTASH(gv) != stash))
	Perl_warner(aTHX_ WARN_DEPRECATED,
	  "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
	     HvNAME(stash), (int)len, name);

    /*
     * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
     * The subroutine's original name may not be "AUTOLOAD", so we don't
     * use that, but for lack of anything better we will use the sub's
     * original package to look up $AUTOLOAD.
     */
    varstash = GvSTASH(CvGV(cv));
    vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
    ENTER;

#ifdef USE_THREADS
    sv_lock((SV *)varstash);
#endif
    if (!isGV(vargv))
	gv_init(vargv, varstash, autoload, autolen, FALSE);
    LEAVE;
    varsv = GvSV(vargv);
#ifdef USE_THREADS
    sv_lock(varsv);
#endif
    sv_setpv(varsv, HvNAME(stash));
    sv_catpvn(varsv, "::", 2);
    sv_catpvn(varsv, name, len);
    SvTAINTED_off(varsv);
    return gv;
}
开发者ID:fduhia,项目名称:metamage_1,代码行数:55,代码来源:gv.c


示例4: SvRV

modperl_handler_t *modperl_handler_new_from_sv(pTHX_ apr_pool_t *p, SV *sv)
{
    char *name = NULL;
    GV *gv;

    if (SvROK(sv)) {
        sv = SvRV(sv);
    }

    switch (SvTYPE(sv)) {
      case SVt_PV:
        name = SvPVX(sv);
        return modperl_handler_new(p, apr_pstrdup(p, name));
        break;
      case SVt_PVCV:
        if (CvANON((CV*)sv)) {
            return modperl_handler_new_anon(aTHX_ p, (CV*)sv);
        }
        if (!(gv = CvGV((CV*)sv))) {
            Perl_croak(aTHX_ "can't resolve the code reference");
        }
        name = apr_pstrcat(p, HvNAME(GvSTASH(gv)), "::", GvNAME(gv), NULL);
        return modperl_handler_new(p, name);
      default:
        break;
    };

    return NULL;
}
开发者ID:gitpan,项目名称:mod_perl,代码行数:29,代码来源:modperl_handler.c


示例5: Perl_gv_fetchmethod_autoload

GV *
Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
{
    register const char *nend;
    const char *nsplit = 0;
    GV* gv;

    for (nend = name; *nend; nend++) {
	if (*nend == '\'')
	    nsplit = nend;
	else if (*nend == ':' && *(nend + 1) == ':')
	    nsplit = ++nend;
    }
    if (nsplit) {
	const char *origname = name;
	name = nsplit + 1;
	if (*nsplit == ':')
	    --nsplit;
	if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
	    /* ->SUPER::method should really be looked up in original stash */
	    SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
						  CopSTASHPV(PL_curcop)));
	    stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
	    DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
			 origname, HvNAME(stash), name) );
	}
	else
	    stash = gv_stashpvn(origname, nsplit - origname, TRUE);
    }

    gv = gv_fetchmeth(stash, name, nend - name, 0);
    if (!gv) {
	if (strEQ(name,"import") || strEQ(name,"unimport"))
	    gv = (GV*)&PL_sv_yes;
	else if (autoload)
	    gv = gv_autoload4(stash, name, nend - name, TRUE);
    }
    else if (autoload) {
	CV* cv = GvCV(gv);
	if (!CvROOT(cv) && !CvXSUB(cv)) {
	    GV* stubgv;
	    GV* autogv;

	    if (CvANON(cv))
		stubgv = gv;
	    else {
		stubgv = CvGV(cv);
		if (GvCV(stubgv) != cv)		/* orphaned import */
		    stubgv = gv;
	    }
	    autogv = gv_autoload4(GvSTASH(stubgv),
				  GvNAME(stubgv), GvNAMELEN(stubgv), TRUE);
	    if (autogv)
		gv = autogv;
	}
    }

    return gv;
}
开发者ID:fduhia,项目名称:metamage_1,代码行数:59,代码来源:gv.c


示例6: hv_delete

SV *PerlIONginxInput_newhandle(pTHX_ ngx_http_request_t *r)
{
    ngx_log_t *log = r->connection->log;

    GV *gv = (GV*)SvREFCNT_inc(newGVgen("Nginx::PSGI::Input"));
    if (!gv)
        return &PL_sv_undef;

    (void) hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);

    /* Body in memory */
    if (r->request_body == NULL || r->request_body->temp_file == NULL) {
        ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
                "Open filehandle with 'ngx_input' layer to read from buffers");

        PerlIO *f = PerlIO_allocate(aTHX);

        if (!(f = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_nginx_input), "<", NULL)) ) {
            ngx_log_error(NGX_LOG_ERR, log, 0,
                    "Error pushing layer to FH"
                    );
            return &PL_sv_undef;
        }

        if (!do_open(gv, "+<&", 3, FALSE, O_RDONLY, 0, f)) {
            ngx_log_error(NGX_LOG_ERR, log, 0,
                    "Error opening GV"
                    );
            // FIXME PerlIO_close
            return &PL_sv_undef;
        }

        PerlIONginxInput *st = PerlIOSelf(f, PerlIONginxInput);
        st->r = r;

    } else {
        /* Body in temp file */

        ngx_log_debug1(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
                "Open PSGI request body temp file '%s'",
                r->request_body->temp_file->file.name.data
                );
        bool result = do_open(gv,(char*)r->request_body->temp_file->file.name.data, r->request_body->temp_file->file.name.len,FALSE,O_RDONLY,0,NULL);

        if (!result) {
            ngx_log_error(NGX_LOG_ERR, log, 0,
                    "Error opening file"
                    );
            // FIXME PerlIO_close
            return NULL;

        }
    }

    return (SV*)newRV_noinc((SV *)gv);
}
开发者ID:nginx-modules,项目名称:ngx_mod_psgi,代码行数:56,代码来源:ngx_http_psgi_input_stream.c


示例7: Perl_gv_init

void
Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
{
    register GP *gp;
    bool doproto = SvTYPE(gv) > SVt_NULL;
    char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL;

    sv_upgrade((SV*)gv, SVt_PVGV);
    if (SvLEN(gv)) {
	if (proto) {
	    SvPVX(gv) = NULL;
	    SvLEN(gv) = 0;
	    SvPOK_off(gv);
	} else
	    Safefree(SvPVX(gv));
    }
    Newz(602, gp, 1, GP);
    GvGP(gv) = gp_ref(gp);
    GvSV(gv) = NEWSV(72,0);
    GvLINE(gv) = CopLINE(PL_curcop);
    GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
    GvCVGEN(gv) = 0;
    GvEGV(gv) = gv;
    sv_magic((SV*)gv, (SV*)gv, '*', Nullch, 0);
    GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
    GvNAME(gv) = savepvn(name, len);
    GvNAMELEN(gv) = len;
    if (multi || doproto)              /* doproto means it _was_ mentioned */
	GvMULTI_on(gv);
    if (doproto) {			/* Replicate part of newSUB here. */
	SvIOK_off(gv);
	ENTER;
	/* XXX unsafe for threads if eval_owner isn't held */
	start_subparse(0,0);		/* Create CV in compcv. */
	GvCV(gv) = PL_compcv;
	LEAVE;

	PL_sub_generation++;
	CvGV(GvCV(gv)) = gv;
	CvFILE(GvCV(gv)) = CopFILE(PL_curcop);
	CvSTASH(GvCV(gv)) = PL_curstash;
#ifdef USE_THREADS
	CvOWNER(GvCV(gv)) = 0;
	if (!CvMUTEXP(GvCV(gv))) {
	    New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
	    MUTEX_INIT(CvMUTEXP(GvCV(gv)));
	}
#endif /* USE_THREADS */
	if (proto) {
	    sv_setpv((SV*)GvCV(gv), proto);
	    Safefree(proto);
	}
    }
}
开发者ID:fduhia,项目名称:metamage_1,代码行数:54,代码来源:gv.c


示例8: THX_MopMcV_get_method

SV* THX_MopMcV_get_method(pTHX_ SV* metaclass, SV* name) {
    HV* stash = (HV*) SvRV(metaclass);

    HE* method_gv_he = hv_fetch_ent(stash, name, 0, 0);
    if (method_gv_he != NULL) {
        GV* method_gv = (GV*) HeVAL(method_gv_he);
        CV* method    = GvCV(method_gv);
        if (method != NULL && GvSTASH(CvGV(method)) == stash) {
            return newRV_inc((SV*) method);  
        }
    }
    
    return NULL;
}
开发者ID:stevan,项目名称:p5-mop-XS,代码行数:14,代码来源:p5mop_class.c


示例9: THX_MopMcV_has_method

bool THX_MopMcV_has_method(pTHX_ SV* metaclass, SV* name) {
    HV* stash = (HV*) SvRV(metaclass);

    HE* method_gv_he = hv_fetch_ent(stash, name, 0, 0);
    if (method_gv_he != NULL) {
        GV* method_gv = (GV*) HeVAL(method_gv_he);
        CV* method    = GvCV(method_gv);
        if (method != NULL && GvSTASH(CvGV(method)) == stash) {
            return TRUE;
        }
    }
    
    return FALSE;
}
开发者ID:stevan,项目名称:p5-mop-XS,代码行数:14,代码来源:p5mop_class.c


示例10: S_croak_xs_usage

STATIC void
S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
{
    const GV *const gv = CvGV(cv);

    PERL_ARGS_ASSERT_CROAK_XS_USAGE;

    if (gv) {
        const char *const gvname = GvNAME(gv);
        const HV *const stash = GvSTASH(gv);
        const char *const hvname = stash ? HvNAME(stash) : NULL;

        if (hvname)
            Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
        else
            Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
    } else {
        /* Pants. I don't think that it should be possible to get here. */
        Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
    }
}
开发者ID:macholic,项目名称:perl5,代码行数:21,代码来源:Byte.c


示例11: hv_delete

SV *PerlIONginxError_newhandle(pTHX_ ngx_http_request_t *r)
{
    GV *gv = (GV*)SvREFCNT_inc(newGVgen("Nginx::PSGI::Error"));
    if (!gv)
        return &PL_sv_undef;

    (void) hv_delete(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), G_DISCARD);
    PerlIO *f = PerlIO_allocate(aTHX);

    if (!(f = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_nginx_error), ">", NULL)) ) {
         return &PL_sv_undef;
    }

    if (!do_open(gv, "+>&", 3, FALSE, O_WRONLY, 0, f)) {
        return &PL_sv_undef;
    }

    PerlIONginxError *st = PerlIOSelf(f, PerlIONginxError);
    st->log = r->connection->log;

    return newRV_noinc((SV*)gv);
}
开发者ID:envi,项目名称:ngx_mod_psgi,代码行数:22,代码来源:ngx_http_psgi_error_stream.c


示例12: modperl_package_clear_stash

static void modperl_package_clear_stash(pTHX_ const char *package)
{
    HV *stash;
    if ((stash = gv_stashpv(package, FALSE))) {
        HE *he;
        I32 len;
        char *key;
        hv_iterinit(stash);
        while ((he = hv_iternext(stash))) {
            key = hv_iterkey(he, &len);
            if (MP_SAFE_STASH(key, len)) {
                SV *val = hv_iterval(stash, he);
                /* The safe thing to do is to skip over stash entries
                 * that don't come from the package we are trying to
                 * unload
                 */
                if (GvSTASH(val) == stash) {
                    (void)hv_delete(stash, key, len, G_DISCARD);
                }
            }
        }
    }
}
开发者ID:gitpan,项目名称:mod_perl,代码行数:23,代码来源:modperl_util.c


示例13: Perl_gv_autoload4

GV*
Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
{
    char autoload[] = "AUTOLOAD";
    STRLEN autolen = sizeof(autoload)-1;
    GV* gv;
    CV* cv;
    HV* varstash;
    GV* vargv;
    SV* varsv;
    char *packname = "";

    if (len == autolen && strnEQ(name, autoload, autolen))
	return Nullgv;
    if (stash) {
	if (SvTYPE(stash) < SVt_PVHV) {
	    packname = SvPV_nolen((SV*)stash);
	    stash = Nullhv;
	}
	else {
	    packname = HvNAME(stash);
	}
    }
    if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
	return Nullgv;
    cv = GvCV(gv);

    if (!(CvROOT(cv) || CvXSUB(cv)))
	return Nullgv;

    /*
     * Inheriting AUTOLOAD for non-methods works ... for now.
     */
    if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && !method &&
	(GvCVGEN(gv) || GvSTASH(gv) != stash))
	Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
	  "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
	     packname, (int)len, name);

    if (CvXSUB(cv)) {
        /* rather than lookup/init $AUTOLOAD here
         * only to have the XSUB do another lookup for $AUTOLOAD
         * and split that value on the last '::',
         * pass along the same data via some unused fields in the CV
         */
        CvSTASH(cv) = stash;
        SvPVX(cv) = (char *)name; /* cast to lose constness warning */
        SvCUR(cv) = len;
        return gv;
    }

    /*
     * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
     * The subroutine's original name may not be "AUTOLOAD", so we don't
     * use that, but for lack of anything better we will use the sub's
     * original package to look up $AUTOLOAD.
     */
    varstash = GvSTASH(CvGV(cv));
    vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
    ENTER;

    if (!isGV(vargv))
	gv_init(vargv, varstash, autoload, autolen, FALSE);
    LEAVE;
    varsv = GvSV(vargv);
    sv_setpv(varsv, packname);
    sv_catpvn(varsv, "::", 2);
    sv_catpvn(varsv, name, len);
    SvTAINTED_off(varsv);
    return gv;
}
开发者ID:gitpan,项目名称:ponie,代码行数:71,代码来源:gv.c


示例14: Perl_gv_fetchmethod_autoload

GV *
Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
{
    register const char *nend;
    const char *nsplit = 0;
    GV* gv;
    HV* ostash = stash;

    if (stash && SvTYPE(stash) < SVt_PVHV)
	stash = Nullhv;

    for (nend = name; *nend; nend++) {
	if (*nend == '\'')
	    nsplit = nend;
	else if (*nend == ':' && *(nend + 1) == ':')
	    nsplit = ++nend;
    }
    if (nsplit) {
	const char *origname = name;
	name = nsplit + 1;
	if (*nsplit == ':')
	    --nsplit;
	if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
	    /* ->SUPER::method should really be looked up in original stash */
	    SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
						  CopSTASHPV(PL_curcop)));
	    /* __PACKAGE__::SUPER stash should be autovivified */
	    stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
	    DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
			 origname, HvNAME(stash), name) );
	}
	else {
            /* don't autovifify if ->NoSuchStash::method */
            stash = gv_stashpvn(origname, nsplit - origname, FALSE);

	    /* however, explicit calls to Pkg::SUPER::method may
	       happen, and may require autovivification to work */
	    if (!stash && (nsplit - origname) >= 7 &&
		strnEQ(nsplit - 7, "::SUPER", 7) &&
		gv_stashpvn(origname, nsplit - origname - 7, FALSE))
	      stash = gv_stashpvn(origname, nsplit - origname, TRUE);
	}
	ostash = stash;
    }

    gv = gv_fetchmeth(stash, name, nend - name, 0);
    if (!gv) {
	if (strEQ(name,"import") || strEQ(name,"unimport"))
	    gv = (GV*)&PL_sv_yes;
	else if (autoload)
	    gv = gv_autoload4(ostash, name, nend - name, TRUE);
    }
    else if (autoload) {
	CV* cv = GvCV(gv);
	if (!CvROOT(cv) && !CvXSUB(cv)) {
	    GV* stubgv;
	    GV* autogv;

	    if (CvANON(cv))
		stubgv = gv;
	    else {
		stubgv = CvGV(cv);
		if (GvCV(stubgv) != cv)		/* orphaned import */
		    stubgv = gv;
	    }
	    autogv = gv_autoload4(GvSTASH(stubgv),
				  GvNAME(stubgv), GvNAMELEN(stubgv), TRUE);
	    if (autogv)
		gv = autogv;
	}
    }

    return gv;
}
开发者ID:gitpan,项目名称:ponie,代码行数:74,代码来源:gv.c


示例15: c_test

    void c_test (int max){
        int i;
        for (f=1)
        
        
    }

#line 23 "ko_6_1_0_perllint_01cc.c"
#ifndef PERL_UNUSED_VAR
#  define PERL_UNUSED_VAR(var) if (0) var = var
#endif

#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)

/* prototype to pass -Wmissing-prototypes */
STATIC void
S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params);

STATIC void
S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
{
    const GV *const gv = CvGV(cv);

    PERL_ARGS_ASSERT_CROAK_XS_USAGE;

    if (gv) {
        const char *const gvname = GvNAME(gv);
        const HV *const stash = GvSTASH(gv);
        const char *const hvname = stash ? HvNAME(stash) : NULL;

        if (hvname)
            Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
        else
            Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
    } else {
        /* Pants. I don't think that it should be possible to get here. */
        Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
    }
}
#undef  PERL_ARGS_ASSERT_CROAK_XS_USAGE

#ifdef PERL_IMPLICIT_CONTEXT
#define croak_xs_usage(a,b)	S_croak_xs_usage(aTHX_ a,b)
#else
#define croak_xs_usage		S_croak_xs_usage
#endif

#endif

/* NOTE: the prototype of newXSproto() is different in versions of perls,
 * so we define a portable version of newXSproto()
 */
#ifdef newXS_flags
#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
#else
#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
#endif /* !defined(newXS_flags) */

#line 75 "ko_6_1_0_perllint_01cc.c"

XS(XS_main_c_test); /* prototype to pass -Wmissing-prototypes */
XS(XS_main_c_test)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 1)
       croak_xs_usage(cv,  "max");
    PERL_UNUSED_VAR(ax); /* -Wall */
    SP -= items;
    {
	int	max = (int)SvIV(ST(0));
#line 22 "ko_6_1_0_perllint_01cc.xs"
	I32* temp;
#line 93 "ko_6_1_0_perllint_01cc.c"
#line 24 "ko_6_1_0_perllint_01cc.xs"
	temp = PL_markstack_ptr++;
	c_test(max);
	if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
	  PL_markstack_ptr = temp;
	  XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
	return; /* assume stack size is correct */
#line 104 "ko_6_1_0_perllint_01cc.c"
	PUTBACK;
	return;
    }
}

#ifdef __cplusplus
extern "C"
#endif
XS(boot_ko_6_1_0_perllint_01cc); /* prototype to pass -Wmissing-prototypes */
XS(boot_ko_6_1_0_perllint_01cc)
{
//.........这里部分代码省略.........
开发者ID:motomatt69,项目名称:perl5lib_mho,代码行数:101,代码来源:ko_6_1_0_perllint_01cc.c


示例16: names

/*
=for apidoc mro_package_moved

Call this function to signal to a stash that it has been assigned to
another spot in the stash hierarchy.  C<stash> is the stash that has been
assigned.  C<oldstash> is the stash it replaces, if any.  C<gv> is the glob
that is actually being assigned to.

This can also be called with a null first argument to
indicate that C<oldstash> has been deleted.

This function invalidates isa caches on the old stash, on all subpackages
nested inside it, and on the subclasses of all those, including
non-existent packages that have corresponding entries in C<stash>.

It also sets the effective names (C<HvENAME>) on all the stashes as
appropriate.

If the C<gv> is present and is not in the symbol table, then this function
simply returns.  This checked will be skipped if C<flags & 1>.

=cut
*/
void
Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
                       const GV * const gv, U32 flags)
{
    SV *namesv;
    HEK **namep;
    I32 name_count;
    HV *stashes;
    HE* iter;

    PERL_ARGS_ASSERT_MRO_PACKAGE_MOVED;
    assert(stash || oldstash);

    /* Determine the name(s) of the location that stash was assigned to
     * or from which oldstash was removed.
     *
     * We cannot reliably use the name in oldstash, because it may have
     * been deleted from the location in the symbol table that its name
     * suggests, as in this case:
     *
     *   $globref = \*foo::bar::;
     *   Symbol::delete_package("foo");
     *   *$globref = \%baz::;
     *   *$globref = *frelp::;
     *      # calls mro_package_moved(%frelp::, %baz::, *$globref, NULL, 0)
     *
     * So we get it from the gv. But, since the gv may no longer be in the
     * symbol table, we check that first. The only reliable way to tell is
     * to see whether its stash has an effective name and whether the gv
     * resides in that stash under its name. That effective name may be
     * different from what gv_fullname4 would use.
     * If flags & 1, the caller has asked us to skip the check.
     */
    if(!(flags & 1)) {
        SV **svp;
        if(
            !GvSTASH(gv) || !HvENAME(GvSTASH(gv)) ||
            !(svp = hv_fetchhek(GvSTASH(gv), GvNAME_HEK(gv), 0)) ||
            *svp != (SV *)gv
        ) return;
    }
    assert(SvOOK(GvSTASH(gv)));
    assert(GvNAMELEN(gv));
    assert(GvNAME(gv)[GvNAMELEN(gv) - 1] == ':');
    assert(GvNAMELEN(gv) == 1 || GvNAME(gv)[GvNAMELEN(gv) - 2] == ':');
    name_count = HvAUX(GvSTASH(gv))->xhv_name_count;
    if (!name_count) {
        name_count = 1;
        namep = &HvAUX(GvSTASH(gv))->xhv_name_u.xhvnameu_name;
    }
    else {
        namep = HvAUX(GvSTASH(gv))->xhv_name_u.xhvnameu_names;
        if (name_count < 0) ++namep, name_count = -name_count - 1;
    }
    if (name_count == 1) {
        if (HEK_LEN(*namep) == 4 && strnEQ(HEK_KEY(*namep), "main", 4)) {
            namesv = GvNAMELEN(gv) == 1
                     ? newSVpvs_flags(":", SVs_TEMP)
                     : newSVpvs_flags("",  SVs_TEMP);
        }
        else {
            namesv = sv_2mortal(newSVhek(*namep));
            if (GvNAMELEN(gv) == 1) sv_catpvs(namesv, ":");
            else                    sv_catpvs(namesv, "::");
        }
        if (GvNAMELEN(gv) != 1) {
            sv_catpvn_flags(
                namesv, GvNAME(gv), GvNAMELEN(gv) - 2,
                /* skip trailing :: */
                GvNAMEUTF8(gv) ? SV_CATUTF8 : SV_CATBYTES
            );
        }
    }
    else {
        SV *aname;
        namesv = sv_2mortal((SV *)newAV());
        while (name_count--) {
//.........这里部分代码省略.........
开发者ID:greearb,项目名称:perl-5.23-3-ct,代码行数:101,代码来源:mro_core.c



注:本文中的GvSTASH函数示例由纯净天空整理自Github/MSDocs等源码及文档管理平台,相关代码片段筛选自各路编程大神贡献的开源项目,源码版权归原作者所有,传播和使用请参考对应项目的License;未经允许,请勿转载。


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
C++ H2O_STRLIT函数代码示例发布时间:2022-05-30
下一篇:
C++ GvNAME函数代码示例发布时间:2022-05-30
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap