From: Nicholas Clark Date: Thu, 23 Feb 2006 18:00:19 +0000 (+0000) Subject: Remove set magic from typeglobs. Remove typeglob magic entirely. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c0c446747ad6c5bde53bc8415ca16ef77f6320f2;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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;