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
