Remove set magic from typeglobs. Remove typeglob magic entirely.

Typeglobs now never access the SvPVX, SvIVX or SvNVX when holding a
valid GvGP().

p4raw-id: //depot/perl@27289

diff --git a/dump.c b/dump.c
index bf88590..880bbae 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -894,7 +894,6 @@ static const struct { const char type; const char *name; } magic_names[] = {
        { PERL_MAGIC_sv,             "sv(\\0)" },
        { PERL_MAGIC_arylen,         "arylen(#)" },
        { PERL_MAGIC_rhash,          "rhash(%)" },
-       { PERL_MAGIC_glob,           "glob(*)" },
        { PERL_MAGIC_pos,            "pos(.)" },
        { PERL_MAGIC_symtab,         "symtab(:)" },
        { PERL_MAGIC_backref,        "backref(<)" },
@@ -956,7 +955,6 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
             else if (v == &PL_vtbl_dbline)     s = "dbline";
             else if (v == &PL_vtbl_isa)        s = "isa";
             else if (v == &PL_vtbl_arylen)     s = "arylen";
-            else if (v == &PL_vtbl_glob)       s = "glob";
             else if (v == &PL_vtbl_mglob)      s = "mglob";
             else if (v == &PL_vtbl_nkeys)      s = "nkeys";
             else if (v == &PL_vtbl_taint)      s = "taint";

diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t
index 1be75cc..f21ca6c 100644 (file)
--- a/ext/Devel/Peek/t/Peek.t
+++ b/ext/Devel/Peek/t/Peek.t
@@ -305,14 +305,10 @@ do_test(17,
        *a,
 'SV = PVGV\\($ADDR\\) at $ADDR
   REFCNT = 5
-  FLAGS = \\(SMG,SCREAM,MULTI(?:,IN_PAD)?\\)
+  FLAGS = \\(SCREAM,MULTI(?:,IN_PAD)?\\)
   IV = 0
   NV = 0
   PV = 0
-  MAGIC = $ADDR
-    MG_VIRTUAL = &PL_vtbl_glob
-    MG_TYPE = PERL_MAGIC_glob\(\*\)
-    MG_OBJ = $ADDR
   NAME = "a"
   NAMELEN = 1
   GvSTASH = $ADDR\\t"main"

diff --git a/gv.c b/gv.c
index 20c2d47..7197e26 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -204,7 +204,6 @@ 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)

diff --git a/perl.h b/perl.h
index 78469bd..9f4e806 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3485,7 +3485,6 @@ Gid_t getegid (void);
 #define PERL_MAGIC_substr        'x' /* substr() lvalue */
 #define PERL_MAGIC_defelem       'y' /* Shadow "foreach" iterator variable /
                                        smart parameter vivification */
-#define PERL_MAGIC_glob                  '*' /* GV (typeglob) */
 #define PERL_MAGIC_arylen        '#' /* Array length ($#ary) */
 #define PERL_MAGIC_pos           '.' /* pos() lvalue */
 #define PERL_MAGIC_backref       '<' /* for weak ref data */
@@ -4496,17 +4495,6 @@ MGVTBL_SET(
 );
 
 MGVTBL_SET(
-    PL_vtbl_glob,
-    NULL,
-    MEMBER_TO_FPTR(Perl_magic_setglob),
-    NULL,
-    NULL,
-    NULL,
-    NULL,
-    NULL
-);
-
-MGVTBL_SET(
     PL_vtbl_mglob,
     NULL,
     MEMBER_TO_FPTR(Perl_magic_setmglob),

diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index 7d1392a..0d17aa4 100644 (file)
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -1060,7 +1060,6 @@ The current kinds of Magic Virtual Tables are:
     y  PERL_MAGIC_defelem        vtbl_defelem   Shadow "foreach" iterator
                                                variable / smart parameter
                                                vivification
-    *  PERL_MAGIC_glob           vtbl_glob      GV (typeglob)
     #  PERL_MAGIC_arylen         vtbl_arylen    Array length ($#ary)
     .  PERL_MAGIC_pos            vtbl_pos       pos() lvalue
     <  PERL_MAGIC_backref        vtbl_backref   back pointer to a weak ref 

diff --git a/sv.c b/sv.c
index 5b63207..9cc8f53 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3170,7 +3170,6 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
        /* don't upgrade SVt_PVLV: it can hold a glob */
        if (dtype != SVt_PVLV)
            sv_upgrade(dstr, SVt_PVGV);
-       sv_magic(dstr, dstr, PERL_MAGIC_glob, NULL, 0);
        GvSTASH(dstr) = GvSTASH(sstr);
        if (GvSTASH(dstr))
            Perl_sv_add_backref(aTHX_ (SV*)GvSTASH(dstr), dstr);
@@ -3496,6 +3495,21 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        assert(!(sflags & SVf_NOK));
        assert(!(sflags & SVf_IOK));
     }
+    else if (dtype == SVt_PVGV) {
+       if (!(sflags & SVf_OK)) {
+           if (ckWARN(WARN_MISC))
+               Perl_warner(aTHX_ packWARN(WARN_MISC),
+                           "Undefined value assigned to typeglob");
+       }
+       else {
+           GV *gv = gv_fetchsv(sstr, GV_ADD, SVt_PVGV);
+           if (dstr != (SV*)gv) {
+               if (GvGP(dstr))
+                   gp_free((GV*)dstr);
+               GvGP(dstr) = gp_ref(GvGP(gv));
+           }
+       }
+    }
     else if (sflags & SVp_POK) {
         bool isSwipe = 0;
 
@@ -3650,11 +3664,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        }
     }
     else {
-       if (dtype == SVt_PVGV) {
-           if (ckWARN(WARN_MISC))
-               Perl_warner(aTHX_ packWARN(WARN_MISC), "Undefined value assigned to typeglob");
-       }
-       else if ((stype == SVt_PVGV || stype == SVt_PVLV)
+       if ((stype == SVt_PVGV || stype == SVt_PVLV)
                 && (sflags & SVp_SCREAM)) {
            /* This stringification rule for globs is spread in 3 places.
               This feels bad. FIXME.  */
@@ -4493,9 +4503,6 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     case PERL_MAGIC_defelem:
        vtable = &PL_vtbl_defelem;
        break;
-    case PERL_MAGIC_glob:
-       vtable = &PL_vtbl_glob;
-       break;
     case PERL_MAGIC_arylen:
        vtable = &PL_vtbl_arylen;
        break;
@@ -7665,7 +7672,6 @@ S_sv_unglob(pTHX_ SV *sv)
        sv_del_backref((SV*)GvSTASH(sv), sv);
        GvSTASH(sv) = NULL;
     }
-    sv_unmagic(sv, PERL_MAGIC_glob);
     SvSCREAM_off(sv);
     Safefree(GvNAME(sv));
     GvMULTI_off(sv);

diff --git a/util.c b/util.c
index 50e0141..065a4c7 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3281,9 +3281,6 @@ Perl_get_vtbl(pTHX_ int vtbl_id)
     case want_vtbl_arylen:
        result = &PL_vtbl_arylen;
        break;
-    case want_vtbl_glob:
-       result = &PL_vtbl_glob;
-       break;
     case want_vtbl_mglob:
        result = &PL_vtbl_mglob;
        break;