From: Nicholas Clark Date: Fri, 7 Jan 2005 12:46:07 +0000 (+0000) Subject: Stage 1 of utf8 support for soft references. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7a5fd60d4ce737f71e7a689eaa2061a36dd225dc;p=p5sagit%2Fp5-mst-13.2.git Stage 1 of utf8 support for soft references. Change gv_fetchpv to take a UTF8 flag, as gv_fetchpvn_flags Add gv_fetchsv to look up a GV by SV rather than a char * pointer Provide a backwards compatability gv_fetchpv Migrate from gv_fetchpv to gv_fetchsv where the caller was grabbing the pointer from an SV All tests still pass. p4raw-id: //depot/perl@23766 --- diff --git a/embed.fnc b/embed.fnc index 4ca621f..d7336b7 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1486,4 +1486,8 @@ np |long |my_betohl |long n np |void |my_swabn |void* ptr|int n +Ap |GV* |gv_fetchpvn_flags|const char* name|STRLEN len|I32 flags|I32 sv_type +Ap |GV* |gv_fetchsv|SV *name|I32 flags|I32 sv_type +dp |bool |is_gv_magical_sv|SV *name|U32 flags + END_EXTERN_C diff --git a/embed.h b/embed.h index f9113f8..dacd251 100644 --- a/embed.h +++ b/embed.h @@ -2278,6 +2278,11 @@ #ifdef PERL_CORE #define my_swabn Perl_my_swabn #endif +#define gv_fetchpvn_flags Perl_gv_fetchpvn_flags +#define gv_fetchsv Perl_gv_fetchsv +#ifdef PERL_CORE +#define is_gv_magical_sv Perl_is_gv_magical_sv +#endif #define ck_anoncode Perl_ck_anoncode #define ck_bitop Perl_ck_bitop #define ck_concat Perl_ck_concat @@ -4893,6 +4898,11 @@ #ifdef PERL_CORE #define my_swabn Perl_my_swabn #endif +#define gv_fetchpvn_flags(a,b,c,d) Perl_gv_fetchpvn_flags(aTHX_ a,b,c,d) +#define gv_fetchsv(a,b,c) Perl_gv_fetchsv(aTHX_ a,b,c) +#ifdef PERL_CORE +#define is_gv_magical_sv(a,b) Perl_is_gv_magical_sv(aTHX_ a,b) +#endif #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) diff --git a/global.sym b/global.sym index 0ff8888..cdd5e05 100644 --- a/global.sym +++ b/global.sym @@ -673,3 +673,5 @@ Perl_save_set_svflags Perl_hv_assert Perl_hv_clear_placeholders Perl_hv_scalar +Perl_gv_fetchpvn_flags +Perl_gv_fetchsv diff --git a/gv.c b/gv.c index 4b34bd4..0019f93 100644 --- a/gv.c +++ b/gv.c @@ -650,7 +650,21 @@ Perl_gv_stashsv(pTHX_ SV *sv, I32 create) GV * -Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) +Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) { + STRLEN len = strlen (nambeg); + return gv_fetchpvn_flags(nambeg, len, add, sv_type); +} + +GV * +Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type) { + STRLEN len; + const char *nambeg = SvPV(name, len); + return gv_fetchpvn_flags(nambeg, len, flags | SvUTF8(name), sv_type); +} + +GV * +Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, + I32 sv_type) { register const char *name = nambeg; register GV *gv = 0; @@ -658,6 +672,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) I32 len; register const char *namend; HV *stash = 0; + I32 add = flags & ~SVf_UTF8; + I32 utf8 = flags & SVf_UTF8; if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */ name++; @@ -1819,6 +1835,22 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) /* =for apidoc is_gv_magical +Returns C if given the name of a magical GV. Calls is_gv_magical. + +=cut +*/ + +bool +Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags) +{ + STRLEN len; + char *temp = SvPV(name, len); + return is_gv_magical(temp, len, flags); +} + +/* +=for apidoc is_gv_magical + Returns C if given the name of a magical GV. Currently only useful internally when determining if a GV should be diff --git a/gv.h b/gv.h index 6e14f44..30a9114 100644 --- a/gv.h +++ b/gv.h @@ -153,6 +153,8 @@ Return the SV from the GV. #define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */ #define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval */ #define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */ - +/* SVf_UTF8 (more accurately the return value from SvUTF8) is also valid + as a flag to gv_fetch_pvn_flags, so ensure it lies outside this range. +*/ #define gv_fullname3(sv,gv,prefix) gv_fullname4(sv,gv,prefix,TRUE) #define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE) diff --git a/mg.c b/mg.c index 4a29a07..8315721 100644 --- a/mg.c +++ b/mg.c @@ -1764,16 +1764,11 @@ Perl_magic_getglob(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg) { - register char *s; GV* gv; - STRLEN n_a; - + if (!SvOK(sv)) return 0; - s = SvPV(sv, n_a); - if (*s == '*' && s[1]) - s++; - gv = gv_fetchpv(s,TRUE, SVt_PVGV); + gv = gv_fetchsv(sv,TRUE, SVt_PVGV); if (sv == (SV*)gv) return 0; if (GvGP(sv)) @@ -2212,12 +2207,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) case '^': Safefree(IoTOP_NAME(GvIOp(PL_defoutgv))); IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len)); - IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); + IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO); break; case '~': Safefree(IoFMT_NAME(GvIOp(PL_defoutgv))); IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len)); - IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); + IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO); break; case '=': IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); diff --git a/op.c b/op.c index 0008732..38a10df 100644 --- a/op.c +++ b/op.c @@ -4204,10 +4204,13 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } else aname = Nullch; - gv = gv_fetchpv(name ? name : (aname ? aname : - (PL_curstash ? "__ANON__" : "__ANON__::__ANON__")), - GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT), - SVt_PVCV); + gv = name ? gv_fetchsv(cSVOPo->op_sv, + GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT), + SVt_PVCV) + : gv_fetchpv(aname ? aname + : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"), + GV_ADDMULTI | ((block || attrs) ? 0 : GV_NOINIT), + SVt_PVCV); if (o) SAVEFREEOP(o); @@ -4675,15 +4678,13 @@ void Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) { register CV *cv; - char *name; GV *gv; - STRLEN n_a; if (o) - name = SvPVx(cSVOPo->op_sv, n_a); + gv = gv_fetchsv(cSVOPo->op_sv, TRUE, SVt_PVFM); else - name = "STDOUT"; - gv = gv_fetchpv(name,TRUE, SVt_PVFM); + gv = gv_fetchpv("STDOUT", TRUE, SVt_PVFM); + #ifdef GV_UNIQUE_CHECK if (GvUNIQUE(gv)) { Perl_croak(aTHX_ "Bad symbol for form (GV is unique)"); @@ -4695,7 +4696,9 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) line_t oldline = CopLINE(PL_curcop); if (PL_copline != NOLINE) CopLINE_set(PL_curcop, PL_copline); - Perl_warner(aTHX_ packWARN(WARN_REDEFINE), "Format %s redefined",name); + Perl_warner(aTHX_ packWARN(WARN_REDEFINE), + o ? "Format %"SVf" redefined" + : "Format STDOUT redefined" ,cSVOPo->op_sv); CopLINE_set(PL_curcop, oldline); } SvREFCNT_dec(cv); @@ -5109,11 +5112,9 @@ Perl_ck_rvconst(pTHX_ register OP *o) o->op_private |= (PL_hints & HINT_STRICT_REFS); if (kid->op_type == OP_CONST) { - char *name; int iscv; GV *gv; SV *kidsv = kid->op_sv; - STRLEN n_a; /* Is it a constant from cv_const_sv()? */ if (SvROK(kidsv) && SvREADONLY(kidsv)) { @@ -5143,7 +5144,6 @@ Perl_ck_rvconst(pTHX_ register OP *o) Perl_croak(aTHX_ "Constant is not %s reference", badtype); return o; } - name = SvPV(kidsv, n_a); if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) { char *badthing = Nullch; switch (o->op_type) { @@ -5159,8 +5159,8 @@ Perl_ck_rvconst(pTHX_ register OP *o) } if (badthing) Perl_croak(aTHX_ - "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use", - name, badthing); + "Can't use bareword (\"%"SVf"\") as %s ref while \"strict refs\" in use", + kidsv, badthing); } /* * This is a little tricky. We only want to add the symbol if we @@ -5172,7 +5172,7 @@ Perl_ck_rvconst(pTHX_ register OP *o) */ iscv = (o->op_type == OP_RV2CV) * 2; do { - gv = gv_fetchpv(name, + gv = gv_fetchsv(kidsv, iscv | !(kid->op_private & OPpCONST_ENTERED), iscv ? SVt_PVCV @@ -5215,9 +5215,8 @@ Perl_ck_ftst(pTHX_ OP *o) SVOP *kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - STRLEN n_a; OP *newop = newGVOP(type, OPf_REF, - gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO)); + gv_fetchsv(kid->op_sv, TRUE, SVt_PVIO)); op_free(o); o = newop; return o; @@ -5259,7 +5258,6 @@ Perl_ck_fun(pTHX_ OP *o) } if (o->op_flags & OPf_KIDS) { - STRLEN n_a; tokid = &cLISTOPo->op_first; kid = cLISTOPo->op_first; if (kid->op_type == OP_PUSHMARK || @@ -5302,13 +5300,12 @@ Perl_ck_fun(pTHX_ OP *o) if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - char *name = SvPVx(((SVOP*)kid)->op_sv, n_a); OP *newop = newAVREF(newGVOP(OP_GV, 0, - gv_fetchpv(name, TRUE, SVt_PVAV) )); + gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVAV) )); if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "Array @%s missing the @ in argument %"IVdf" of %s()", - name, (IV)numargs, PL_op_desc[type]); + "Array @%"SVf" missing the @ in argument %"IVdf" of %s()", + ((SVOP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]); op_free(kid); kid = newop; kid->op_sibling = sibl; @@ -5322,13 +5319,12 @@ Perl_ck_fun(pTHX_ OP *o) if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - char *name = SvPVx(((SVOP*)kid)->op_sv, n_a); OP *newop = newHVREF(newGVOP(OP_GV, 0, - gv_fetchpv(name, TRUE, SVt_PVHV) )); + gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVHV) )); if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "Hash %%%s missing the %% in argument %"IVdf" of %s()", - name, (IV)numargs, PL_op_desc[type]); + "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()", + ((SVOP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]); op_free(kid); kid = newop; kid->op_sibling = sibl; @@ -5355,8 +5351,7 @@ Perl_ck_fun(pTHX_ OP *o) (kid->op_private & OPpCONST_BARE)) { OP *newop = newGVOP(OP_GV, 0, - gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE, - SVt_PVIO) ); + gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVIO) ); if (!(o->op_private & 1) && /* if not unop */ kid == cLISTOPo->op_last) cLISTOPo->op_last = newop; diff --git a/perl.h b/perl.h index 3d055e2..4bcf229 100644 --- a/perl.h +++ b/perl.h @@ -3239,6 +3239,8 @@ EXTCONST char PL_no_wrongref[] INIT("Can't use %s ref as %s ref"); EXTCONST char PL_no_symref[] INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); +EXTCONST char PL_no_symref_sv[] + INIT("Can't use string (\"%.32" SVf "\") as %s ref while \"strict refs\" in use"); EXTCONST char PL_no_usym[] INIT("Can't use an undefined value as %s reference"); EXTCONST char PL_no_aelem[] diff --git a/pp.c b/pp.c index 0fa7e24..c0212b9 100644 --- a/pp.c +++ b/pp.c @@ -147,9 +147,6 @@ PP(pp_rv2gv) } else { if (SvTYPE(sv) != SVt_PVGV) { - char *sym; - STRLEN len; - if (SvGMAGICAL(sv)) { mg_get(sv); if (SvROK(sv)) @@ -195,22 +192,21 @@ PP(pp_rv2gv) report_uninit(sv); RETSETUNDEF; } - sym = SvPV(sv,len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { - sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV); - if (!sv - && (!is_gv_magical(sym,len,0) - || !(sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV)))) - { + SV * temp = (SV*)gv_fetchsv(sv, FALSE, SVt_PVGV); + if (!temp + && (!is_gv_magical_sv(sv,0) + || !(sv = (SV*)gv_fetchsv(sv, TRUE, SVt_PVGV)))) { RETSETUNDEF; } + sv = temp; } else { if (PL_op->op_private & HINT_STRICT_REFS) - DIE(aTHX_ PL_no_symref, sym, "a symbol"); - sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV); + DIE(aTHX_ PL_no_symref_sv, sv, "a symbol"); + sv = (SV*)gv_fetchsv(sv, TRUE, SVt_PVGV); } } } @@ -238,8 +234,6 @@ PP(pp_rv2sv) } } else { - char *sym; - STRLEN len; gv = (GV*)sv; if (SvTYPE(gv) != SVt_PVGV) { @@ -256,22 +250,21 @@ PP(pp_rv2sv) report_uninit(sv); RETSETUNDEF; } - sym = SvPV(sv, len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { - gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV); + gv = (GV*)gv_fetchsv(sv, FALSE, SVt_PV); if (!gv - && (!is_gv_magical(sym,len,0) - || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV)))) + && (!is_gv_magical_sv(sv, 0) + || !(gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PV)))) { RETSETUNDEF; } } else { if (PL_op->op_private & HINT_STRICT_REFS) - DIE(aTHX_ PL_no_symref, sym, "a SCALAR"); - gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV); + DIE(aTHX_ PL_no_symref_sv, sv, "a SCALAR"); + gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PV); } } sv = GvSV(gv); diff --git a/pp_hot.c b/pp_hot.c index e41ee3d..6855552 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -725,9 +725,6 @@ PP(pp_rv2av) GV *gv; if (SvTYPE(sv) != SVt_PVGV) { - char *sym; - STRLEN len; - if (SvGMAGICAL(sv)) { mg_get(sv); if (SvROK(sv)) @@ -745,22 +742,21 @@ PP(pp_rv2av) } RETSETUNDEF; } - sym = SvPV(sv,len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { - gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVAV); + gv = (GV*)gv_fetchsv(sv, FALSE, SVt_PVAV); if (!gv - && (!is_gv_magical(sym,len,0) - || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV)))) + && (!is_gv_magical_sv(sv,0) + || !(gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVAV)))) { RETSETUNDEF; } } else { if (PL_op->op_private & HINT_STRICT_REFS) - DIE(aTHX_ PL_no_symref, sym, "an ARRAY"); - gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV); + DIE(aTHX_ PL_no_symref_sv, sv, "an ARRAY"); + gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVAV); } } else { @@ -856,9 +852,6 @@ PP(pp_rv2hv) GV *gv; if (SvTYPE(sv) != SVt_PVGV) { - char *sym; - STRLEN len; - if (SvGMAGICAL(sv)) { mg_get(sv); if (SvROK(sv)) @@ -876,22 +869,21 @@ PP(pp_rv2hv) } RETSETUNDEF; } - sym = SvPV(sv,len); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { - gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVHV); + gv = (GV*)gv_fetchsv(sv, FALSE, SVt_PVHV); if (!gv - && (!is_gv_magical(sym,len,0) - || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV)))) + && (!is_gv_magical_sv(sv,0) + || !(gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVHV)))) { RETSETUNDEF; } } else { if (PL_op->op_private & HINT_STRICT_REFS) - DIE(aTHX_ PL_no_symref, sym, "a HASH"); - gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV); + DIE(aTHX_ PL_no_symref_sv, sv, "a HASH"); + gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PVHV); } } else { @@ -3043,7 +3035,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) if (!SvOK(sv) || !(packname) || - !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) || + !(iogv = gv_fetchsv(sv, FALSE, SVt_PVIO)) || !(ob=(SV*)GvIO(iogv))) { /* this isn't the name of a filehandle either */ diff --git a/pp_sys.c b/pp_sys.c index 356f6f2..e0d9ca0 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1337,7 +1337,7 @@ PP(pp_leavewrite) if (!IoFMT_NAME(io)) IoFMT_NAME(io) = savepv(GvNAME(gv)); topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv))); - topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM); + topgv = gv_fetchsv(topname, FALSE, SVt_PVFM); if ((topgv && GvFORM(topgv)) || !gv_fetchpv("top",FALSE,SVt_PVFM)) IoTOP_NAME(io) = savepv(SvPVX(topname)); @@ -2111,13 +2111,12 @@ PP(pp_truncate) SETERRNO(0,0); #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP) { - STRLEN n_a; int result = 1; GV *tmpgv; IO *io; if (PL_op->op_flags & OPf_SPECIAL) { - tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO); + tmpgv = gv_fetchsv(POPs, FALSE, SVt_PVIO); do_ftruncate_gv: if (!GvIO(tmpgv)) @@ -2144,7 +2143,8 @@ PP(pp_truncate) else { SV *sv = POPs; char *name; - + STRLEN n_a; + if (SvTYPE(sv) == SVt_PVGV) { tmpgv = (GV*)sv; /* *main::FRED for example */ goto do_ftruncate_gv; @@ -3348,8 +3348,7 @@ PP(pp_fttty) dSP; int fd; GV *gv; - char *tmps = Nullch; - STRLEN n_a; + SV *tmpsv = Nullsv; STACKED_FTEST_CHECK; @@ -3360,12 +3359,18 @@ PP(pp_fttty) else if (SvROK(TOPs) && isGV(SvRV(TOPs))) gv = (GV*)SvRV(POPs); else - gv = gv_fetchpv(tmps = POPpx, FALSE, SVt_PVIO); + gv = gv_fetchsv(tmpsv = POPs, FALSE, SVt_PVIO); if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); - else if (tmps && isDIGIT(*tmps)) - fd = atoi(tmps); + else if (tmpsv && SvOK(tmpsv)) { + STRLEN n_a; + char *tmps = SvPV(tmpsv, n_a); + if (isDIGIT(*tmps)) + fd = atoi(tmps); + else + RETPUSHUNDEF; + } else RETPUSHUNDEF; if (PerlLIO_isatty(fd)) diff --git a/proto.h b/proto.h index 9a3cf4d..8c998dd 100644 --- a/proto.h +++ b/proto.h @@ -1425,4 +1425,8 @@ PERL_CALLCONV long Perl_my_betohl(long n); PERL_CALLCONV void Perl_my_swabn(void* ptr, int n); +PERL_CALLCONV GV* Perl_gv_fetchpvn_flags(pTHX_ const char* name, STRLEN len, I32 flags, I32 sv_type); +PERL_CALLCONV GV* Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, I32 sv_type); +PERL_CALLCONV bool Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags); + END_EXTERN_C diff --git a/sv.c b/sv.c index c0f828c..a009dfc 100644 --- a/sv.c +++ b/sv.c @@ -7972,7 +7972,6 @@ Perl_sv_2io(pTHX_ SV *sv) { IO* io; GV* gv; - STRLEN n_a; switch (SvTYPE(sv)) { case SVt_PVIO: @@ -7989,7 +7988,7 @@ Perl_sv_2io(pTHX_ SV *sv) Perl_croak(aTHX_ PL_no_usym, "filehandle"); if (SvROK(sv)) return sv_2io(SvRV(sv)); - gv = gv_fetchpv(SvPV(sv,n_a), FALSE, SVt_PVIO); + gv = gv_fetchsv(sv, FALSE, SVt_PVIO); if (gv) io = GvIO(gv); else @@ -8015,7 +8014,6 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref) { GV *gv = Nullgv; CV *cv = Nullcv; - STRLEN n_a; if (!sv) return *gvp = Nullgv, Nullcv; @@ -8056,7 +8054,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref) else if (isGV(sv)) gv = (GV*)sv; else - gv = gv_fetchpv(SvPV(sv, n_a), lref, SVt_PVCV); + gv = gv_fetchsv(sv, lref, SVt_PVCV); *gvp = gv; if (!gv) return Nullcv; diff --git a/sv.h b/sv.h index e80c755..9fe3657 100644 --- a/sv.h +++ b/sv.h @@ -188,6 +188,7 @@ perform the upgrade if necessary. See C. #define SVp_SCREAM 0x08000000 /* has been studied? */ #define SVf_UTF8 0x20000000 /* SvPV is UTF-8 encoded */ +/* Ensure this value does not clash with the GV_ADD* flags in gv.h */ #define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE) @@ -606,6 +607,8 @@ and leaves the UTF-8 status as it was. =cut */ +/* Ensure the return value of this macro does not clash with the GV_ADD* flags +in gv.h: */ #define SvUTF8(sv) (SvFLAGS(sv) & SVf_UTF8) #define SvUTF8_on(sv) (SvFLAGS(sv) |= (SVf_UTF8)) #define SvUTF8_off(sv) (SvFLAGS(sv) &= ~(SVf_UTF8)) diff --git a/toke.c b/toke.c index 8d343dd..99757a6 100644 --- a/toke.c +++ b/toke.c @@ -5513,7 +5513,7 @@ S_pending_ident(pTHX) sv_catpv(sym, PL_tokenbuf+1); yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym); yylval.opval->op_private = OPpCONST_ENTERED; - gv_fetchpv(SvPVX(sym), + gv_fetchsv(sym, (PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADDMULTI diff --git a/universal.c b/universal.c index caab476..525ae44 100644 --- a/universal.c +++ b/universal.c @@ -859,7 +859,7 @@ XS(XS_PerlIO_get_layers) if (SvROK(sv) && isGV(SvRV(sv))) gv = (GV*)SvRV(sv); else - gv = gv_fetchpv(SvPVX(sv), FALSE, SVt_PVIO); + gv = gv_fetchsv(sv, FALSE, SVt_PVIO); } if (gv && (io = GvIO(gv))) {