Update to IO-1.23

[p5sagit/p5-mst-13.2.git] / gv.c

diff --git a/gv.c b/gv.c
index 20c2d47..e2724ee 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -80,7 +80,8 @@ Perl_gv_IOadd(pTHX_ register GV *gv)
          * if it walks like a dirhandle, then let's assume that
          * this is a dirhandle.
          */
-        const char *fh = PL_op->op_type == OP_READDIR ||
+       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 ||
@@ -161,7 +162,8 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 {
     dVAR;
     register GP *gp;
-    const bool doproto = SvTYPE(gv) > SVt_NULL;
+    const U32 old_type = SvTYPE(gv);
+    const bool doproto = old_type > SVt_NULL;
     const char * const proto = (doproto && SvPOK(gv)) ? SvPVX_const(gv) : NULL;
     SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL;
 
@@ -182,7 +184,12 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
        SvROK_off(gv);
     }
 
-    sv_upgrade((SV*)gv, SVt_PVGV);
+
+    if (old_type < SVt_PVGV) {
+       if (old_type >= SVt_PV)
+           SvCUR_set(gv, 0);
+       sv_upgrade((SV*)gv, SVt_PVGV);
+    }
     if (SvLEN(gv)) {
        if (proto) {
            SvPV_set(gv, NULL);
@@ -192,6 +199,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
            Safefree(SvPVX_mutable(gv));
     }
     Newxz(gp, 1, GP);
+    SvSCREAM_on(gv);
     GvGP(gv) = gp_ref(gp);
 #ifdef PERL_DONT_CREATE_GVSV
     GvSV(gv) = NULL;
@@ -204,13 +212,10 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
     GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : (char *) "";
     GvCVGEN(gv) = 0;
     GvEGV(gv) = gv;
-    sv_magic((SV*)gv, (SV*)gv, PERL_MAGIC_glob, NULL, 0);
-    SvSCREAM_on(gv);
     GvSTASH(gv) = stash;
     if (stash)
        Perl_sv_add_backref(aTHX_ (SV*)stash, (SV*)gv);
-    GvNAME(gv) = savepvn(name, len);
-    GvNAMELEN(gv) = len;
+    gv_name_set(gv, name, len, GV_ADD);
     if (multi || doproto)              /* doproto means it _was_ mentioned */
        GvMULTI_on(gv);
     if (doproto) {                     /* Replicate part of newSUB here. */
@@ -352,7 +357,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
                if (SvTYPE(gv) != SVt_PVGV)
                    gv_init(gv, stash, "ISA", 3, TRUE);
                SvREFCNT_dec(GvAV(gv));
-               GvAV(gv) = (AV*)SvREFCNT_inc(av);
+               GvAV(gv) = (AV*)SvREFCNT_inc_simple(av);
            }
        }
     }
@@ -509,7 +514,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
            --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",
+           SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
                                                  CopSTASHPV(PL_curcop)));
            /* __PACKAGE__::SUPER stash should be autovivified */
            stash = gv_stashpvn(SvPVX_const(tmpstr), SvCUR(tmpstr), TRUE);
@@ -1065,6 +1070,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    goto ro_magicalize;
                if (strEQ(name2, "TF8LOCALE"))
                    goto ro_magicalize;
+               if (strEQ(name2, "TF8CACHE"))
+                   goto magicalize;
                break;
            case '\027':        /* $^WARNING_BITS */
                if (strEQ(name2, "ARNING_BITS"))
@@ -1342,7 +1349,7 @@ Perl_newGVgen(pTHX_ const char *pack)
 {
     dVAR;
     return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++),
-                     TRUE, SVt_PVGV);
+                     GV_ADD, SVt_PVGV);
 }
 
 /* hopefully this is only called on local symbol table entries */
@@ -1375,7 +1382,7 @@ Perl_gp_free(pTHX_ GV *gv)
     dVAR;
     GP* gp;
 
-    if (!gv || !(gp = GvGP(gv)))
+    if (!gv || !isGV_with_GP(gv) || !(gp = GvGP(gv)))
        return;
     if (gp->gp_refcnt == 0) {
        if (ckWARN_d(WARN_INTERNAL))
@@ -1391,6 +1398,7 @@ Perl_gp_free(pTHX_ GV *gv)
     if (--gp->gp_refcnt > 0) {
        if (gp->gp_egv == gv)
            gp->gp_egv = 0;
+       GvGP(gv) = 0;
         return;
     }
 
@@ -1423,7 +1431,7 @@ Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
        int i;
        for (i = 1; i < NofAMmeth; i++) {
            CV * const cv = amtp->table[i];
-           if (cv != NULL) {
+           if (cv) {
                SvREFCNT_dec((SV *) cv);
                amtp->table[i] = NULL;
            }
@@ -1537,7 +1545,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
            cv = (CV*)gv;
            filled = 1;
        }
-       amt.table[i]=(CV*)SvREFCNT_inc(cv);
+       amt.table[i]=(CV*)SvREFCNT_inc_simple(cv);
     }
     if (filled) {
       AMT_AMAGIC_on(&amt);
@@ -1869,7 +1877,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     CATCH_SET(TRUE);
     Zero(&myop, 1, BINOP);
     myop.op_last = (OP *) &myop;
-    myop.op_next = Nullop;
+    myop.op_next = NULL;
     myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
 
     PUSHSTACKi(PERLSI_OVERLOAD);
@@ -1978,6 +1986,7 @@ pointers returned by SvPV.
 bool
 Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags)
 {
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(flags);
 
     if (len > 1) {
@@ -2096,6 +2105,25 @@ Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags)
     return FALSE;
 }
 
+void
+Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
+{
+    dVAR;
+    U32 hash;
+
+    PERL_UNUSED_ARG(flags);
+
+    if (len > I32_MAX)
+       Perl_croak(aTHX_ "panic: gv name too long (%"UVuf")", (UV) len);
+
+    if (!(flags & GV_ADD) && GvNAME_HEK(gv)) {
+       unshare_hek(GvNAME_HEK(gv));
+    }
+
+    PERL_HASH(hash, name, len);
+    GvNAME_HEK(gv) = name ? share_hek(name, len, hash) : 0;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd