In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b7247a80ab6b02ec8a01b2c7c8d927ad173700ea?hp=c035a075a240f10383292128a8d3f3746c4ac857>
- Log ----------------------------------------------------------------- commit b7247a80ab6b02ec8a01b2c7c8d927ad173700ea Author: Father Chrysostomos <[email protected]> Date: Wed Oct 20 21:33:53 2010 -0700 Allow stashes to have multiple names This commits modifies the HvAUX structure as follows: A new field is added, named xhv_name_count, indicating the number of names. If it is zero (the default and most common case), then xhv_name is a HEK * as usual. If it is non-zero, then xhv_name actually holds a pointer to an array of HEK*s, the first being the default or âcanonicalâ name. This code is a little repetitious, but more refactorings are to come, so it is too soon to turn these repetitions into macros. This is yet another commit in preparation for fixing [perl #75176]. Basically, whenever a stash is deleted from its containing stash, if it has an alias elsewhere, it needs to assume the new name (of that alias; so it needs to know its other names already) and update isarev entries. Forthcoming commits will do that. ----------------------------------------------------------------------- Summary of changes: hv.c | 27 ++++++++++++++++++++++++--- hv.h | 17 +++++++++++++---- sv.c | 15 ++++++++++++++- 3 files changed, 51 insertions(+), 8 deletions(-) diff --git a/hv.c b/hv.c index c040e25..d5dacab 100644 --- a/hv.c +++ b/hv.c @@ -1621,6 +1621,7 @@ S_hfreeentries(pTHX_ HV *hv) /* This is the array that we're going to restore */ HE **const orig_array = HvARRAY(hv); HEK *name; + U32 name_count; int attempts = 100; PERL_ARGS_ASSERT_HFREEENTRIES; @@ -1634,9 +1635,11 @@ S_hfreeentries(pTHX_ HV *hv) struct xpvhv_aux *iter = HvAUX(hv); name = iter->xhv_name; + name_count = iter->xhv_name_count; iter->xhv_name = NULL; } else { name = NULL; + name_count = 0; } /* orig_array remains unchanged throughout the loop. If after freeing all @@ -1768,7 +1771,14 @@ S_hfreeentries(pTHX_ HV *hv) assert(HvARRAY(hv)); if (HvAUX(hv)->xhv_name) { - unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0); + if(HvAUX(hv)->xhv_name_count) { + HEK ** const name = (HEK **)HvAUX(hv)->xhv_name; + HEK **hekp = name + HvAUX(hv)->xhv_name_count; + while(hekp-- > name) + unshare_hek_or_pvn(*hekp, 0, 0, 0); + Safefree(name); + } + else unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0); } } @@ -1784,8 +1794,10 @@ S_hfreeentries(pTHX_ HV *hv) /* We have restored the original array. If name is non-NULL, then the original array had an aux structure at the end. So this is valid: */ + struct xpvhv_aux * const aux = HvAUX(hv); SvFLAGS(hv) |= SVf_OOK; - HvAUX(hv)->xhv_name = name; + aux->xhv_name = name; + aux->xhv_name_count = name_count; } } @@ -1883,6 +1895,7 @@ S_hv_auxinit(HV *hv) { iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ iter->xhv_name = 0; + iter->xhv_name_count = 0; iter->xhv_backreferences = 0; iter->xhv_mro_meta = NULL; return iter; @@ -2014,7 +2027,14 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags) if (SvOOK(hv)) { iter = HvAUX(hv); if (iter->xhv_name) { - unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0); + if(iter->xhv_name_count) { + HEK ** const name = (HEK **)HvAUX(hv)->xhv_name; + HEK **hekp = name + HvAUX(hv)->xhv_name_count; + while(hekp-- > name) + unshare_hek_or_pvn(*hekp, 0, 0, 0); + Safefree(name); + } + else unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0); } } else { if (name == 0) @@ -2024,6 +2044,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags) } PERL_HASH(hash, name, len); iter->xhv_name = name ? share_hek(name, len, hash) : NULL; + iter->xhv_name_count = 0; } AV ** diff --git a/hv.h b/hv.h index 6fa3252..3e4040c 100644 --- a/hv.h +++ b/hv.h @@ -79,7 +79,9 @@ struct xpvhv_aux { HE *xhv_eiter; /* current entry of iterator */ I32 xhv_riter; /* current root of iterator */ struct mro_meta *xhv_mro_meta; -}; + U32 xhv_name_count; /* When non-zero, xhv_name is actually */ + /* a pointer to an array of HEKs, this */ +}; /* being the length. */ /* hash structure: */ /* This structure must match the beginning of struct xpvmg in sv.h. */ @@ -256,12 +258,19 @@ C<SV*>. /* FIXME - all of these should use a UTF8 aware API, which should also involve getting the length. */ +#define HvNAME_HEK_NN(hv) \ + ( \ + HvAUX(hv)->xhv_name_count \ + ? *(HEK **)HvAUX(hv)->xhv_name \ + : HvAUX(hv)->xhv_name \ + ) /* This macro may go away without notice. */ -#define HvNAME_HEK(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_name : NULL) +#define HvNAME_HEK(hv) \ + (SvOOK(hv) && HvAUX(hv)->xhv_name ? HvNAME_HEK_NN(hv) : NULL) #define HvNAME_get(hv) ((SvOOK(hv) && (HvAUX(hv)->xhv_name)) \ - ? HEK_KEY(HvAUX(hv)->xhv_name) : NULL) + ? HEK_KEY(HvNAME_HEK_NN(hv)) : NULL) #define HvNAMELEN_get(hv) ((SvOOK(hv) && (HvAUX(hv)->xhv_name)) \ - ? HEK_LEN(HvAUX(hv)->xhv_name) : 0) + ? HEK_LEN(HvNAME_HEK_NN(hv)) : 0) /* the number of keys (including any placeholers) */ #define XHvTOTALKEYS(xhv) ((xhv)->xhv_keys) diff --git a/sv.c b/sv.c index bfafd73..8db10dc 100644 --- a/sv.c +++ b/sv.c @@ -11732,7 +11732,20 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param) SvFLAGS(dstr) |= SVf_OOK; hvname = saux->xhv_name; - daux->xhv_name = hek_dup(hvname, param); + if (saux->xhv_name_count) { + HEK ** const sname = (HEK **)saux->xhv_name; + const U32 count = saux->xhv_name_count; + HEK **shekp = sname + count; + HEK **dhekp; + Newxc(daux->xhv_name, count, HEK *, HEK); + dhekp = (HEK **)daux->xhv_name + count; + while (shekp-- > sname) { + dhekp--; + *dhekp = hek_dup(*shekp, param); + } + } + else daux->xhv_name = hek_dup(hvname, param); + daux->xhv_name_count = saux->xhv_name_count; daux->xhv_riter = saux->xhv_riter; daux->xhv_eiter = saux->xhv_eiter -- Perl5 Master Repository
