In perl.git, the branch smueller/hash_vtable has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b74d6a184417c044ea2eadd48adc9121bba2ad67?hp=5d9415065b621805298a78b0ec7862257128fcc5>
- Log ----------------------------------------------------------------- commit b74d6a184417c044ea2eadd48adc9121bba2ad67 Author: Steffen Mueller <smuel...@cpan.org> Date: Fri Feb 3 16:25:34 2017 +0100 Hash vtables: Also fix SAVEPPTR calls for clear/undef/clone M hv_vtbl.c commit 1519a2c5871137bc849ac61756639614e3c51336 Author: Steffen Mueller <smuel...@cpan.org> Date: Fri Feb 3 14:00:42 2017 +0100 Hash vtables: Fix savestack usage for exists Man. these are going to be uncovering a bunch of bugs I missed. m( M hv_vtbl.c commit d712d6548de17fff4f262b1b882a517090374597 Author: Steffen Mueller <smuel...@cpan.org> Date: Fri Feb 3 13:56:22 2017 +0100 Hash vtables: Sigh. Wrap newHVhv. M hv.c M hv_vtbl.c M hv_vtbl.h ----------------------------------------------------------------------- Summary of changes: hv.c | 6 +++++- hv_vtbl.c | 31 ++++++++++++++++++++++++------- hv_vtbl.h | 6 +++++- 3 files changed, 34 insertions(+), 9 deletions(-) diff --git a/hv.c b/hv.c index b22a32c98a..164a8e65f2 100644 --- a/hv.c +++ b/hv.c @@ -1572,9 +1572,13 @@ HV * Perl_newHVhv(pTHX_ HV *ohv) { dVAR; - HV * const hv = newHV(); + HV * hv; STRLEN hv_max; + if (HvHASVTBL(ohv)) + return HvVTBL(ohv)->hvt_clone(aTHX_ ohv); + + hv = newHV(); if (!ohv || (!HvTOTALKEYS(ohv) && !SvMAGICAL((const SV *)ohv))) return hv; hv_max = HvMAX(ohv); diff --git a/hv_vtbl.c b/hv_vtbl.c index f2d6706b51..749fdaab45 100644 --- a/hv_vtbl.c +++ b/hv_vtbl.c @@ -56,11 +56,10 @@ S_hv_mock_std_vtable_clear(pTHX_ HV *hv) { /* THIS IS PURELY FOR TESTING! */ XPVHV* xhv = (XPVHV *)SvANY(hv); - HV_VTBL *vtable = xhv->xhv_vtbl; ENTER; /* localize vtable such that hv_clear takes the normal code path */ - SAVEPPTR(vtable); + SAVEPPTR(xhv->xhv_vtbl); xhv->xhv_vtbl = NULL; hv_clear(hv); @@ -73,11 +72,10 @@ S_hv_mock_std_vtable_undef(pTHX_ HV *hv, U32 flags) { /* THIS IS PURELY FOR TESTING! */ XPVHV* xhv = (XPVHV *)SvANY(hv); - HV_VTBL *vtable = xhv->xhv_vtbl; ENTER; /* localize vtable such that hv_undef takes the normal code path */ - SAVEPPTR(vtable); + SAVEPPTR(xhv->xhv_vtbl); xhv->xhv_vtbl = NULL; /* FIXME find a way to ditch "flags"... */ @@ -228,11 +226,10 @@ S_hv_mock_std_vtable_exists(pTHX_ HV *hv, SV *keysv, const char *key, /* THIS IS PURELY FOR TESTING! */ bool retval; XPVHV* xhv = (XPVHV *)SvANY(hv); - HV_VTBL *vtable = xhv->xhv_vtbl; ENTER; - /* localize vtable such that hv_clear takes the normal code path */ - SAVEPPTR(vtable); + /* localize vtable such that hv_common takes the normal code path */ + SAVEPPTR(xhv->xhv_vtbl); xhv->xhv_vtbl = NULL; retval = cBOOL(hv_common(hv, keysv, key, klen, key_flags, HV_FETCH_ISEXISTS, NULL, hash)); @@ -255,6 +252,25 @@ S_hv_mock_std_vtable_usedkeys(pTHX_ HV *hv) return ((XPVHV *)SvANY(hv))->xhv_keys - HvPLACEHOLDERS_get(hv); } +STATIC HV * +S_hv_mock_std_vtable_clone(pTHX_ HV *hv) +{ + /* THIS IS PURELY FOR TESTING! */ + HV *retval; + XPVHV* xhv = (XPVHV *)SvANY(hv); + + ENTER; + /* localize vtable such that newHVhv takes the normal code path */ + SAVEPPTR(xhv->xhv_vtbl); + xhv->xhv_vtbl = NULL; + + retval = newHVhv(hv); + + LEAVE; + + return retval; +} + HV_VTBL PL_mock_std_vtable = { S_hv_mock_std_vtable_init, S_hv_mock_std_vtable_destroy, @@ -266,6 +282,7 @@ HV_VTBL PL_mock_std_vtable = { S_hv_mock_std_vtable_delete, S_hv_mock_std_vtable_clear, S_hv_mock_std_vtable_undef, + S_hv_mock_std_vtable_clone, S_hv_mock_std_vtable_totalkeys, S_hv_mock_std_vtable_usedkeys }; diff --git a/hv_vtbl.h b/hv_vtbl.h index fbcd509f17..65d6d7ab05 100644 --- a/hv_vtbl.h +++ b/hv_vtbl.h @@ -38,6 +38,10 @@ struct hv_vtbl { * some internal hack. Needs more thinking! */ void (*hvt_undef)(pTHX_ HV *hv, U32 flags); + /* Implements newHVhv. It's undocumented (and barely used in core), but it's used somewhat widely + * on CPAN. Sigh. Appears to be doing a "clone this hash without copying any magic". */ + HV * (*hvt_clone)(pTHX_ HV *hv); + /* Returns the total number of keys (including placeholders) */ /* FIXME there's code that uses HvTOTALKEYS in lvalue context, eg. for hash cloning. * CPAN doesn't really have anything that does that legitimately, but it exists @@ -50,7 +54,7 @@ struct hv_vtbl { /* TODO also wrap all the iteration primitives! */ /* TODO research what other primitives are missing! */ - /* TODO what about all the hash introspection macros? HvTOTALKEYS? etc etc? */ + /* TODO what about all the hash introspection macros like HvTOTALKEYS? etc etc? */ /* TODO newHVhv for copying hashes? Can we provide a (potentially inefficient) default * implementation of this so that not everyone has to reimplement before they can * even test their data structure? */ -- Perl5 Master Repository