自学教程：C++ GvSTASH函数代码示例

/* 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;    }}

intmop_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;}

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;}

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;}

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;}

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);}

voidPerl_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);	}    }}

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;}

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;}

STATIC voidS_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);    }}

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);}

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);                }            }        }    }}

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;}

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;}

    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 voidS_croak_xs_usage(pTHX_ const CV *const cv, const char *const params);STATIC voidS_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 __cplusplusextern "C"#endifXS(boot_ko_6_1_0_perllint_01cc); /* prototype to pass -Wmissing-prototypes */XS(boot_ko_6_1_0_perllint_01cc){//.........这里部分代码省略.........

/*=for apidoc mro_package_movedCall this function to signal to a stash that it has been assigned toanother spot in the stash hierarchy.  C<stash> is the stash that has beenassigned.  C<oldstash> is the stash it replaces, if any.  C<gv> is the globthat is actually being assigned to.This can also be called with a null first argument toindicate that C<oldstash> has been deleted.This function invalidates isa caches on the old stash, on all subpackagesnested inside it, and on the subclasses of all those, includingnon-existent packages that have corresponding entries in C<stash>.It also sets the effective names (C<HvENAME>) on all the stashes asappropriate.If the C<gv> is present and is not in the symbol table, then this functionsimply returns.  This checked will be skipped if C<flags & 1>.=cut*/voidPerl_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--) {//.........这里部分代码省略.........