In perl.git, the branch smueller/hash_vtable has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/92b89cd0800250731a058c71c1c70678311155e7?hp=9cd309521371513749f3cb538ee3b93ba3b5f392>
- Log -----------------------------------------------------------------
commit 92b89cd0800250731a058c71c1c70678311155e7
Author: Steffen Mueller <smuel...@cpan.org>
Date: Wed Jan 25 21:27:39 2017 +0100
Hash vtables: hv_clear equivalent
Best I can tell, this leaves the ugly two cases: fetch and store. Kind
of important I suppose...
But really, while I can follow it (generally), I'm not a fan of the
density of hv_common. Very resistant to gentle refactoring. :(
-----------------------------------------------------------------------
Summary of changes:
hv.c | 4 ++++
hv_vtbl.c | 25 ++++++++++++++++++++++++-
hv_vtbl.h | 4 ++--
3 files changed, 30 insertions(+), 3 deletions(-)
diff --git a/hv.c b/hv.c
index 06a2d9584b..24f77a7c57 100644
--- a/hv.c
+++ b/hv.c
@@ -1753,6 +1753,10 @@ Perl_hv_clear(pTHX_ HV *hv)
xhv = (XPVHV*)SvANY(hv);
+ if (xhv->xhv_vtbl != NULL) {
+ xhv->xhv_vtbl->hvt_clear(aTHX_ hv);
+ }
+
/* avoid hv being freed when calling destructors below */
EXTEND_MORTAL(1);
PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(hv);
diff --git a/hv_vtbl.c b/hv_vtbl.c
index 6266b96ccc..d6b5cd30d7 100644
--- a/hv_vtbl.c
+++ b/hv_vtbl.c
@@ -37,6 +37,23 @@ S_hv_mock_std_vtable_delete(pTHX_ HV *hv, SV *keysv, const
char *key,
key_flags, delete_flags, hash);
}
+STATIC void
+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);
+
+ xhv->xhv_vtbl = NULL;
+ hv_clear(hv);
+
+ LEAVE;
+}
+
/*
STATIC SV **
S_hv_mock_std_vtable_fetch(pTHX_ HV *hv, SV *keysv, const char *key,
@@ -55,16 +72,21 @@ S_hv_mock_std_vtable_exists(pTHX_ HV *hv, SV *keysv, const
char *key,
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);
xhv->xhv_vtbl = NULL;
+
if (keysv)
retval = hv_exists_ent(hv, keysv, hash);
else {
I32 my_klen = (key_flags & HVhek_UTF8) ? -(I32)klen : (I32)klen;
retval = hv_exists(hv, key, my_klen);
}
+
LEAVE;
+
return retval;
}
@@ -73,7 +95,8 @@ HV_VTBL PL_mock_std_vtable = {
S_hv_mock_std_vtable_destroy,
/* S_hv_mock_std_vtable_fetch, */
S_hv_mock_std_vtable_exists,
- S_hv_mock_std_vtable_delete
+ S_hv_mock_std_vtable_delete,
+ S_hv_mock_std_vtable_clear
};
/*
diff --git a/hv_vtbl.h b/hv_vtbl.h
index ba4ba3238f..6e79d2d25c 100644
--- a/hv_vtbl.h
+++ b/hv_vtbl.h
@@ -22,8 +22,8 @@ struct hv_vtbl {
bool (*hvt_exists)(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN
klen, int key_flags, U32 hash);
/* Implements the various forms of hv_delete/etc */
SV * (*hvt_delete)(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN
klen, int key_flags, I32 delete_flags, U32 hash);
-
- /* clear */
+ /* Implements the equivalent of hv_clear */
+ void (*hvt_clear)(pTHX_ HV *hv);
};
typedef struct hv_vtbl HV_VTBL;
--
Perl5 Master Repository
