In perl.git, the branch smueller/hash_vtable has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/9e821d0e5999fd089de04633c8d62a610b5d9e60?hp=0c46d9e638cf4383f6bbed7084abc77a44bfeb5e>
- Log -----------------------------------------------------------------
commit 9e821d0e5999fd089de04633c8d62a610b5d9e60
Author: Steffen Mueller <smuel...@cpan.org>
Date: Thu Feb 2 09:56:26 2017 +0100
Hash vtables: Add some TODO markers
M hv_vtbl.h
commit 9fc76bf4764df09dabfd46516e0bbb4bf0015064
Author: Steffen Mueller <smuel...@cpan.org>
Date: Thu Feb 2 09:55:16 2017 +0100
Hash vtables: Expose hv_undef
Sigh. The hash API is way "richer" than I'd like it to be!
M hv.c
M hv_vtbl.c
M hv_vtbl.h
-----------------------------------------------------------------------
Summary of changes:
hv.c | 7 ++++++-
hv_vtbl.c | 20 +++++++++++++++++++-
hv_vtbl.h | 12 +++++++++++-
3 files changed, 36 insertions(+), 3 deletions(-)
diff --git a/hv.c b/hv.c
index 5938bdfaf0..4f68f92794 100644
--- a/hv.c
+++ b/hv.c
@@ -2014,9 +2014,14 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
if (!hv)
return;
- save = cBOOL(SvREFCNT(hv));
+
DEBUG_A(Perl_hv_assert(aTHX_ hv));
xhv = (XPVHV*)SvANY(hv);
+ if (HvBODYHASVTBL(xhv)) {
+ return HvBODYVTBL(xhv)->hvt_undef(aTHX_ hv);
+ }
+
+ save = cBOOL(SvREFCNT(hv));
/* The name must be deleted before the call to hfreeeeentries so that
CVs are anonymised properly. But the effective name must be pre-
diff --git a/hv_vtbl.c b/hv_vtbl.c
index 8300f95334..1d4b40ef3e 100644
--- a/hv_vtbl.c
+++ b/hv_vtbl.c
@@ -68,6 +68,23 @@ S_hv_mock_std_vtable_clear(pTHX_ HV *hv)
LEAVE;
}
+STATIC void
+S_hv_mock_std_vtable_undef(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_undef takes the normal code path */
+ SAVEPPTR(vtable);
+
+ xhv->xhv_vtbl = NULL;
+ hv_undef(hv);
+
+ LEAVE;
+}
+
STATIC SV **
S_hv_mock_std_vtable_fetch(pTHX_ HV *hv, SV *keysv, const char *key,
STRLEN klen, int key_flags,
@@ -172,7 +189,8 @@ HV_VTBL PL_mock_std_vtable = {
S_hv_mock_std_vtable_fetch_ent,
S_hv_mock_std_vtable_exists,
S_hv_mock_std_vtable_delete,
- S_hv_mock_std_vtable_clear
+ S_hv_mock_std_vtable_clear,
+ S_hv_mock_std_vtable_undef
};
/*
diff --git a/hv_vtbl.h b/hv_vtbl.h
index ddf27ddc79..71f8b44382 100644
--- a/hv_vtbl.h
+++ b/hv_vtbl.h
@@ -19,7 +19,7 @@ struct hv_vtbl {
/* fetch_flags can contain at least HV_FETCH_LVALUE and HV_FETCH_EMPTY_HE
*/
HE * (*hvt_fetch_ent)(pTHX_ HV *hv, SV *keysv, const char *key,
STRLEN klen, int key_flags, I32 fetch_flags, U32 hash);
- /* store */
+ /* TODO store */
/* Implements the equivalent of hv_exists(_ent) */
bool (*hvt_exists)(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN
klen, int key_flags, U32 hash);
@@ -27,6 +27,16 @@ struct hv_vtbl {
SV * (*hvt_delete)(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN
klen, int key_flags, int delete_flags, U32 hash);
/* Implements the equivalent of hv_clear */
void (*hvt_clear)(pTHX_ HV *hv);
+
+ /* Implements the equivalent of hv_undef (which should be at least
including all that hv_clear does). */
+ /* FIXME Perl_hv_undef_flags() has a flags parameter that is used when
called from sv_clear, which
+ * seems to be a "no, really do away with everything" sort of corner
case. Need to understand
+ * significance for this much better. Is that just for stashes? But
really, I'd hate to expose
+ * some internal hack. Needs more thinking! */
+ void (*hvt_undef)(pTHX_ HV *hv);
+
+ /* TODO also wrap all the iteration primitives! */
+ /* TODO research what other primitives are missing! */
};
typedef struct hv_vtbl HV_VTBL;
--
Perl5 Master Repository
