static const char S_autoload[] = "AUTOLOAD";
static const STRLEN S_autolen = sizeof(S_autoload)-1;
-
-#ifdef PERL_DONT_CREATE_GVSV
GV *
-Perl_gv_SVadd(pTHX_ GV *gv)
+Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
{
- PERL_ARGS_ASSERT_GV_SVADD;
-
- if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV)
- Perl_croak(aTHX_ "Bad symbol for scalar");
- if (!GvSV(gv))
- GvSV(gv) = newSV(0);
- return gv;
-}
-#endif
-
-GV *
-Perl_gv_AVadd(pTHX_ register GV *gv)
-{
- PERL_ARGS_ASSERT_GV_AVADD;
-
- if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV)
- Perl_croak(aTHX_ "Bad symbol for array");
- if (!GvAV(gv))
- GvAV(gv) = newAV();
- return gv;
-}
-
-GV *
-Perl_gv_HVadd(pTHX_ register GV *gv)
-{
- PERL_ARGS_ASSERT_GV_HVADD;
-
- if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV)
- Perl_croak(aTHX_ "Bad symbol for hash");
- if (!GvHV(gv))
- GvHV(gv) = newHV();
- return gv;
-}
-
-GV *
-Perl_gv_IOadd(pTHX_ register GV *gv)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_GV_IOADD;
+ SV **where;
if (!gv || SvTYPE((const SV *)gv) != SVt_PVGV) {
-
- /*
- * if it walks like a dirhandle, then let's assume that
- * this is a dirhandle.
- */
- const char * const fh =
- PL_op->op_type == OP_READDIR ||
- PL_op->op_type == OP_TELLDIR ||
- PL_op->op_type == OP_SEEKDIR ||
- PL_op->op_type == OP_REWINDDIR ||
- PL_op->op_type == OP_CLOSEDIR ?
- "dirhandle" : "filehandle";
- /* diag_listed_as: Bad symbol for filehandle */
- Perl_croak(aTHX_ "Bad symbol for %s", fh);
+ const char *what;
+ if (type == SVt_PVIO) {
+ /*
+ * if it walks like a dirhandle, then let's assume that
+ * this is a dirhandle.
+ */
+ what = PL_op->op_type == OP_READDIR ||
+ PL_op->op_type == OP_TELLDIR ||
+ PL_op->op_type == OP_SEEKDIR ||
+ PL_op->op_type == OP_REWINDDIR ||
+ PL_op->op_type == OP_CLOSEDIR ?
+ "dirhandle" : "filehandle";
+ /* diag_listed_as: Bad symbol for filehandle */
+ } else if (type == SVt_PVHV) {
+ what = "hash";
+ } else {
+ what = type == SVt_PVAV ? "array" : "scalar";
+ }
+ Perl_croak(aTHX_ "Bad symbol for %s", what);
}
- if (!GvIOp(gv)) {
- GvIOp(gv) = newIO();
+ if (type == SVt_PVHV) {
+ where = (SV **)&GvHV(gv);
+ } else if (type == SVt_PVAV) {
+ where = (SV **)&GvAV(gv);
+ } else if (type == SVt_PVIO) {
+ where = (SV **)&GvIOp(gv);
+ } else {
+ where = &GvSV(gv);
}
+
+ if (!*where)
+ *where = newSV_type(type);
return gv;
}
return gp;
}
+/* Assign CvGV(cv) = gv, handling weak references.
+ * See also S_anonymise_cv_maybe */
+
+void
+Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
+{
+ GV * const oldgv = CvGV(cv);
+ PERL_ARGS_ASSERT_CVGV_SET;
+
+ if (oldgv == gv)
+ return;
+
+ if (oldgv) {
+ if (CvANON(cv))
+ SvREFCNT_dec(oldgv);
+ else {
+ assert(strNE(GvNAME(oldgv),"__ANON__"));
+ sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv));
+ }
+ }
+
+ CvGV(cv) = gv;
+
+ if (!gv)
+ return;
+
+ if (CvANON(cv)) {
+ assert(strnEQ(GvNAME(gv),"__ANON__", 8));
+ SvREFCNT_inc_simple_void_NN(gv);
+ }
+ else {
+ assert(strNE(GvNAME(gv),"__ANON__"));
+ Perl_sv_add_backref(aTHX_ MUTABLE_SV(gv), MUTABLE_SV(cv));
+ }
+}
+
+
void
Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
{
if (multi || doproto) /* doproto means it _was_ mentioned */
GvMULTI_on(gv);
if (doproto) { /* Replicate part of newSUB here. */
+ CV *cv;
ENTER;
if (has_constant) {
/* newCONSTSUB takes ownership of the reference from us. */
- GvCV(gv) = newCONSTSUB(stash, name, has_constant);
+ cv = newCONSTSUB(stash, name, has_constant);
/* If this reference was a copy of another, then the subroutine
must have been "imported", by a Perl space assignment to a GV
from a reference to CV. */
GvIMPORTED_CV_on(gv);
} else {
(void) start_subparse(0,0); /* Create empty CV in compcv. */
- GvCV(gv) = PL_compcv;
+ cv = PL_compcv;
}
+ GvCV(gv) = cv;
LEAVE;
mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar($) { (shift) } sub ASDF::baz($); *ASDF::baz = \&Foo::bar */
- CvGV(GvCV(gv)) = gv;
- CvFILE_set_from_cop(GvCV(gv), PL_curcop);
- CvSTASH(GvCV(gv)) = PL_curstash;
+ cvgv_set(cv, gv);
+ CvFILE_set_from_cop(cv, PL_curcop);
+ CvSTASH(cv) = PL_curstash;
+ if (PL_curstash)
+ Perl_sv_add_backref(aTHX_ MUTABLE_SV(PL_curstash), MUTABLE_SV(cv));
if (proto) {
- sv_usepvn_flags(MUTABLE_SV(GvCV(gv)), proto, protolen,
+ sv_usepvn_flags(MUTABLE_SV(cv), proto, protolen,
SV_HAS_TRAILING_NUL);
}
}
cstash = gv_stashsv(linear_sv, 0);
if (!cstash) {
- if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA",
- SVfARG(linear_sv), hvname);
+ Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA",
+ SVfARG(linear_sv), hvname);
continue;
}
* Inheriting AUTOLOAD for non-methods works ... for now.
*/
if (!method && (GvCVGEN(gv) || GvSTASH(gv) != stash)
- && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)
)
- Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
- packname, (int)len, name);
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+ "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
+ packname, (int)len, name);
if (CvISXSUB(cv)) {
/* rather than lookup/init $AUTOLOAD here
* pass along the same data via some unused fields in the CV
*/
CvSTASH(cv) = stash;
+ if (stash)
+ Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(cv));
SvPV_set(cv, (char *)name); /* cast to lose constness warning */
SvCUR_set(cv, len);
return gv;
char *tmpbuf;
HV *stash;
GV *tmpgv;
+ U32 tmplen = namelen + 2;
PERL_ARGS_ASSERT_GV_STASHPVN;
- if (namelen + 2 <= sizeof smallbuf)
+ if (tmplen <= sizeof smallbuf)
tmpbuf = smallbuf;
else
- Newx(tmpbuf, namelen + 2, char);
- Copy(name,tmpbuf,namelen,char);
- tmpbuf[namelen++] = ':';
- tmpbuf[namelen++] = ':';
- tmpgv = gv_fetchpvn_flags(tmpbuf, namelen, flags, SVt_PVHV);
+ Newx(tmpbuf, tmplen, char);
+ Copy(name, tmpbuf, namelen, char);
+ tmpbuf[namelen] = ':';
+ tmpbuf[namelen+1] = ':';
+ tmpgv = gv_fetchpvn_flags(tmpbuf, tmplen, flags, SVt_PVHV);
if (tmpbuf != smallbuf)
Safefree(tmpbuf);
if (!tmpgv)
(sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) )
{
/* diag_listed_as: Variable "%s" is not imported%s */
- Perl_warn(aTHX_ "Variable \"%c%s\" is not imported",
+ Perl_ck_warner_d(
+ aTHX_ packWARN(WARN_MISC),
+ "Variable \"%c%s\" is not imported",
sv_type == SVt_PVAV ? '@' :
sv_type == SVt_PVHV ? '%' : '$',
name);
if (GvCVu(*gvp))
- Perl_warn(aTHX_ "\t(Did you mean &%s instead?)\n", name);
+ Perl_ck_warner_d(
+ aTHX_ packWARN(WARN_MISC),
+ "\t(Did you mean &%s instead?)\n", name
+ );
stash = NULL;
}
}
faking_it = SvOK(gv);
- if (add & GV_ADDWARN && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg);
+ if (add & GV_ADDWARN)
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg);
gv_init(gv, stash, name, len, add & GV_ADDMULTI);
gv_init_sv(gv, faking_it ? SVt_PVCV : sv_type);
/* Names of length 1. (Or 0. But name is NUL terminated, so that will
be case '\0' in this switch statement (ie a default case) */
switch (*name) {
- case '&':
- case '`':
- case '\'':
+ case '&': /* $& */
+ case '`': /* $` */
+ case '\'': /* $' */
if (
sv_type == SVt_PVAV ||
sv_type == SVt_PVHV ||
PL_sawampersand = TRUE;
goto magicalize;
- case ':':
+ case ':': /* $: */
sv_setpv(GvSVn(gv),PL_chopset);
goto magicalize;
- case '?':
+ case '?': /* $? */
#ifdef COMPLEX_STATUS
SvUPGRADE(GvSVn(gv), SVt_PVLV);
#endif
goto magicalize;
- case '!':
+ case '!': /* $! */
GvMULTI_on(gv);
/* If %! has been used, automatically load Errno.pm. */
require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
break;
- case '-':
- case '+':
+ case '-': /* $- */
+ case '+': /* $+ */
GvMULTI_on(gv); /* no used once warnings here */
{
AV* const av = GvAVn(gv);
break;
}
- case '*':
- case '#':
- if (sv_type == SVt_PV && ckWARN2_d(WARN_DEPRECATED, WARN_SYNTAX))
- Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "$%c is no longer supported", *name);
+ case '*': /* $* */
+ case '#': /* $# */
+ if (sv_type == SVt_PV)
+ Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
+ "$%c is no longer supported", *name);
break;
- case '|':
+ case '|': /* $| */
sv_setiv(GvSVn(gv), (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0);
goto magicalize;
ro_magicalize:
SvREADONLY_on(GvSVn(gv));
/* FALL THROUGH */
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9':
- case '[':
- case '^':
- case '~':
- case '=':
- case '%':
- case '.':
- case '(':
- case ')':
- case '<':
- case '>':
- case '\\':
- case '/':
+ case '0': /* $0 */
+ case '1': /* $1 */
+ case '2': /* $2 */
+ case '3': /* $3 */
+ case '4': /* $4 */
+ case '5': /* $5 */
+ case '6': /* $6 */
+ case '7': /* $7 */
+ case '8': /* $8 */
+ case '9': /* $9 */
+ case '[': /* $[ */
+ case '^': /* $^ */
+ case '~': /* $~ */
+ case '=': /* $= */
+ case '%': /* $% */
+ case '.': /* $. */
+ case '(': /* $( */
+ case ')': /* $) */
+ case '<': /* $< */
+ case '>': /* $> */
+ case '\\': /* $\ */
+ case '/': /* $/ */
case '\001': /* $^A */
case '\003': /* $^C */
case '\004': /* $^D */
sv_setpvs(GvSVn(gv),"\f");
PL_formfeed = GvSVn(gv);
break;
- case ';':
+ case ';': /* $; */
sv_setpvs(GvSVn(gv),"\034");
break;
- case ']':
+ case ']': /* $] */
{
SV * const sv = GvSVn(gv);
if (!sv_derived_from(PL_patchlevel, "version"))
void
Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
{
- const GV * const egv = GvEGV(gv);
+ const GV * const egv = GvEGVx(gv);
PERL_ARGS_ASSERT_GV_EFULLNAME4;
gv_fullname4(sv, egv ? egv : gv, prefix, keepmain);
}
-IO *
-Perl_newIO(pTHX)
-{
- dVAR;
- GV *iogv;
- IO * const io = MUTABLE_IO(newSV_type(SVt_PVIO));
- /* This used to read SvREFCNT(io) = 1;
- It's not clear why the reference count needed an explicit reset. NWC
- */
- assert (SvREFCNT(io) == 1);
- SvOBJECT_on(io);
- /* Clear the stashcache because a new IO could overrule a package name */
- hv_clear(PL_stashcache);
- iogv = gv_fetchpvs("FileHandle::", 0, SVt_PVHV);
- /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
- if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
- iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
- SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
- return io;
-}
-
void
Perl_gv_check(pTHX_ const HV *stash)
{
if (!gv || !isGV_with_GP(gv) || !(gp = GvGP(gv)))
return;
if (gp->gp_refcnt == 0) {
- if (ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
- "Attempt to free unreferenced glob pointers"
- pTHX__FORMAT pTHX__VALUE);
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+ "Attempt to free unreferenced glob pointers"
+ pTHX__FORMAT pTHX__VALUE);
return;
}
if (--gp->gp_refcnt > 0) {
}
/* Updates and caches the CV's */
+/* Returns:
+ * 1 on success and there is some overload
+ * 0 if there is no overload
+ * -1 if some error occurred and it couldn't croak
+ */
-bool
+int
Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
{
dVAR;
const AMT * const amtp = (AMT*)mg->mg_ptr;
if (amtp->was_ok_am == PL_amagic_generation
&& amtp->was_ok_sub == newgen) {
- return (bool)AMT_OVERLOADED(amtp);
+ return AMT_OVERLOADED(amtp) ? 1 : 0;
}
sv_unmagic(MUTABLE_SV(stash), PERL_MAGIC_overload_table);
}
{
/* Can be an import stub (created by "can"). */
if (destructing) {
- return FALSE;
+ return -1;
}
else {
const char * const name = (gvsv && SvPOK(gvsv)) ? SvPVX_const(gvsv) : "???";
AMT_AMAGIC_off(&amt);
sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table,
(char*)&amt, sizeof(AMTS));
- return FALSE;
+ return 0;
}
do_update:
/* If we're looking up a destructor to invoke, we must avoid
* that Gv_AMupdate croaks, because we might be dying already */
- if (!Gv_AMupdate(stash, id == DESTROY_amg)) {
+ if (Gv_AMupdate(stash, id == DESTROY_amg) == -1) {
/* and if it didn't found a destructor, we fall back
* to a simpler method that will only look for the
* destructor instead of the whole magic */
}
+/* Implement tryAMAGICun_MG macro.
+ Do get magic, then see if the stack arg is overloaded and if so call it.
+ Flags:
+ AMGf_set return the arg using SETs rather than assigning to
+ the targ
+ AMGf_numeric apply sv_2num to the stack arg.
+*/
+
+bool
+Perl_try_amagic_un(pTHX_ int method, int flags) {
+ dVAR;
+ dSP;
+ SV* tmpsv;
+ SV* const arg = TOPs;
+
+ SvGETMAGIC(arg);
+
+ if (SvAMAGIC(arg) && (tmpsv = AMG_CALLun_var(arg,method))) {
+ if (flags & AMGf_set) {
+ SETs(tmpsv);
+ }
+ else {
+ dTARGET;
+ if (SvPADMY(TARG)) {
+ sv_setsv(TARG, tmpsv);
+ SETTARG;
+ }
+ else
+ SETs(tmpsv);
+ }
+ PUTBACK;
+ return TRUE;
+ }
+
+ if ((flags & AMGf_numeric) && SvROK(arg))
+ *sp = sv_2num(arg);
+ return FALSE;
+}
+
+
+/* Implement tryAMAGICbin_MG macro.
+ Do get magic, then see if the two stack args are overloaded and if so
+ call it.
+ Flags:
+ AMGf_set return the arg using SETs rather than assigning to
+ the targ
+ AMGf_assign op may be called as mutator (eg +=)
+ AMGf_numeric apply sv_2num to the stack arg.
+*/
+
+bool
+Perl_try_amagic_bin(pTHX_ int method, int flags) {
+ dVAR;
+ dSP;
+ SV* const left = TOPm1s;
+ SV* const right = TOPs;
+
+ SvGETMAGIC(left);
+ if (left != right)
+ SvGETMAGIC(right);
+
+ if (SvAMAGIC(left) || SvAMAGIC(right)) {
+ SV * const tmpsv = amagic_call(left, right, method,
+ ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0));
+ if (tmpsv) {
+ if (flags & AMGf_set) {
+ (void)POPs;
+ SETs(tmpsv);
+ }
+ else {
+ dATARGET;
+ (void)POPs;
+ if (opASSIGN || SvPADMY(TARG)) {
+ sv_setsv(TARG, tmpsv);
+ SETTARG;
+ }
+ else
+ SETs(tmpsv);
+ }
+ PUTBACK;
+ return TRUE;
+ }
+ }
+ if (flags & AMGf_numeric) {
+ if (SvROK(left))
+ *(sp-1) = sv_2num(left);
+ if (SvROK(right))
+ *sp = sv_2num(right);
+ }
+ return FALSE;
+}
+
+
SV*
Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
{
(void)((cv = cvp[off=bool__amg])
|| (cv = cvp[off=numer_amg])
|| (cv = cvp[off=string_amg]));
- postpr = 1;
+ if (cv)
+ postpr = 1;
break;
case copy_amg:
{
case int_amg:
case iter_amg: /* XXXX Eventually should do to_gv. */
case ftest_amg: /* XXXX Eventually should do to_gv. */
+ case regexp_amg:
/* FAIL safe */
return NULL; /* Delegate operation to standard mechanisms. */
break;
case ge_amg:
case eq_amg:
case ne_amg:
- postpr = 1; off=ncmp_amg; break;
+ off = ncmp_amg;
+ break;
case slt_amg:
case sle_amg:
case sgt_amg:
case sge_amg:
case seq_amg:
case sne_amg:
- postpr = 1; off=scmp_amg; break;
+ off = scmp_amg;
+ break;
}
- if (off != -1) cv = cvp[off];
- if (!cv) {
- goto not_found;
- }
+ if ((off != -1) && (cv = cvp[off]))
+ postpr = 1;
+ else
+ goto not_found;
} else {
not_found: /* No method found, either report or croak */
switch (method) {
- case lt_amg:
- case le_amg:
- case gt_amg:
- case ge_amg:
- case eq_amg:
- case ne_amg:
- case slt_amg:
- case sle_amg:
- case sgt_amg:
- case sge_amg:
- case seq_amg:
- case sne_amg:
- postpr = 0; break;
case to_sv_amg:
case to_av_amg:
case to_hv_amg:
if (( (method + assignshift == off)
&& (assign || (method == inc_amg) || (method == dec_amg)))
|| force_cpy)
+ {
RvDEEPCP(left);
+ }
+
{
dSP;
BINOP myop;
}
/*
+=for apidoc gv_try_downgrade
+
+If the typeglob C<gv> can be expressed more succinctly, by having
+something other than a real GV in its place in the stash, replace it
+with the optimised form. Basic requirements for this are that C<gv>
+is a real typeglob, is sufficiently ordinary, and is only referenced
+from its package. This function is meant to be used when a GV has been
+looked up in part to see what was there, causing upgrading, but based
+on what was found it turns out that the real GV isn't required after all.
+
+If C<gv> is a completely empty typeglob, it is deleted from the stash.
+
+If C<gv> is a typeglob containing only a sufficiently-ordinary constant
+sub, the typeglob is replaced with a scalar-reference placeholder that
+more compactly represents the same thing.
+
+=cut
+*/
+
+void
+Perl_gv_try_downgrade(pTHX_ GV *gv)
+{
+ HV *stash;
+ CV *cv;
+ HEK *namehek;
+ SV **gvp;
+ PERL_ARGS_ASSERT_GV_TRY_DOWNGRADE;
+ if (!(SvREFCNT(gv) == 1 && SvTYPE(gv) == SVt_PVGV && !SvFAKE(gv) &&
+ !SvOBJECT(gv) && !SvREADONLY(gv) &&
+ isGV_with_GP(gv) && GvGP(gv) &&
+ !GvINTRO(gv) && GvREFCNT(gv) == 1 &&
+ !GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIOp(gv) && !GvFORM(gv) &&
+ GvEGVx(gv) == gv && (stash = GvSTASH(gv))))
+ return;
+ if (SvMAGICAL(gv)) {
+ MAGIC *mg;
+ /* only backref magic is allowed */
+ if (SvGMAGICAL(gv) || SvSMAGICAL(gv))
+ return;
+ for (mg = SvMAGIC(gv); mg; mg = mg->mg_moremagic) {
+ if (mg->mg_type != PERL_MAGIC_backref)
+ return;
+ }
+ }
+ cv = GvCV(gv);
+ if (!cv) {
+ HEK *gvnhek = GvNAME_HEK(gv);
+ (void)hv_delete(stash, HEK_KEY(gvnhek),
+ HEK_UTF8(gvnhek) ? -HEK_LEN(gvnhek) : HEK_LEN(gvnhek), G_DISCARD);
+ } else if (GvMULTI(gv) && cv &&
+ !SvOBJECT(cv) && !SvMAGICAL(cv) && !SvREADONLY(cv) &&
+ CvSTASH(cv) == stash && CvGV(cv) == gv &&
+ CvCONST(cv) && !CvMETHOD(cv) && !CvLVALUE(cv) && !CvUNIQUE(cv) &&
+ !CvNODEBUG(cv) && !CvCLONE(cv) && !CvCLONED(cv) && !CvANON(cv) &&
+ (namehek = GvNAME_HEK(gv)) &&
+ (gvp = hv_fetch(stash, HEK_KEY(namehek),
+ HEK_LEN(namehek)*(HEK_UTF8(namehek) ? -1 : 1), 0)) &&
+ *gvp == (SV*)gv) {
+ SV *value = SvREFCNT_inc(CvXSUBANY(cv).any_ptr);
+ SvREFCNT(gv) = 0;
+ sv_clear((SV*)gv);
+ SvREFCNT(gv) = 1;
+ SvFLAGS(gv) = SVt_IV|SVf_ROK;
+ SvANY(gv) = (XPVGV*)((char*)&(gv->sv_u.svu_iv) -
+ STRUCT_OFFSET(XPVIV, xiv_iv));
+ SvRV_set(gv, value);
+ }
+}
+
+/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4