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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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<TRUE> 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<TRUE> 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/sv.h
+++ b/sv.h
@@ -188,6 +188,7 @@ perform the upgrade if necessary.  See C<svtype>.
 #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 (file)
--- 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 (file)
--- 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))) {