In perl.git, the branch smueller/hash_vtable has been updated <http://perl5.git.perl.org/perl.git/commitdiff/4347d67d665588c3315c4531d5cbdb7d280bb777?hp=0088f930e279eefbb657be8a26be2b3976c41fff>
- Log ----------------------------------------------------------------- commit 4347d67d665588c3315c4531d5cbdb7d280bb777 Author: Steffen Mueller <[email protected]> Date: Tue Feb 7 21:55:44 2017 +0100 Hash vtables: wrap hv_iternext ----------------------------------------------------------------------- Summary of changes: hv.c | 3 +++ hv_vtbl.c | 26 ++++++++++++++++++++++++-- hv_vtbl.h | 2 ++ 3 files changed, 29 insertions(+), 2 deletions(-) diff --git a/hv.c b/hv.c index effb83505b..205616fa10 100644 --- a/hv.c +++ b/hv.c @@ -2699,6 +2699,9 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) xhv = (XPVHV*)SvANY(hv); + if (HvBODYHASVTBL(xhv)) + return HvBODYVTBL(xhv)->hvt_iternext(hv, flags); + if (!SvOOK(hv)) { /* Too many things (well, pp_each at least) merrily assume that you can call hv_iternext without calling hv_iterinit, so we'll have to deal diff --git a/hv_vtbl.c b/hv_vtbl.c index c056ce3ec0..540e84a31f 100644 --- a/hv_vtbl.c +++ b/hv_vtbl.c @@ -278,7 +278,7 @@ S_hv_mock_std_vtable_iterinit(pTHX_ HV *hv) I32 retval; ENTER; - /* localize vtable such that hv_clear takes the normal code path */ + /* localize vtable such that hv_iterinit takes the normal code path */ SAVEPPTR(xhv->xhv_vtbl); xhv->xhv_vtbl = NULL; @@ -289,6 +289,27 @@ S_hv_mock_std_vtable_iterinit(pTHX_ HV *hv) return retval; } +STATIC HE * +S_hv_mock_std_vtable_iternext(pTHX_ HV *hv, I32 flags) +{ + /* THIS IS PURELY FOR TESTING! */ + XPVHV* xhv = (XPVHV *)SvANY(hv); + HE *retval; + + assert((flags & (~HV_ITERNEXT_WANTPLACEHOLDERS)) == 0); + + ENTER; + /* localize vtable such that hv_iternext_flags takes the normal code path */ + SAVEPPTR(xhv->xhv_vtbl); + + xhv->xhv_vtbl = NULL; + retval = hv_iternext_flags(hv, flags); + + LEAVE; + + return retval; +} + HV_VTBL PL_mock_std_vtable = { S_hv_mock_std_vtable_init, S_hv_mock_std_vtable_destroy, @@ -303,7 +324,8 @@ HV_VTBL PL_mock_std_vtable = { S_hv_mock_std_vtable_clone, S_hv_mock_std_vtable_totalkeys, S_hv_mock_std_vtable_usedkeys, - S_hv_mock_std_vtable_iterinit + S_hv_mock_std_vtable_iterinit, + S_hv_mock_std_vtable_iternext }; /* diff --git a/hv_vtbl.h b/hv_vtbl.h index bca6f0226c..9b67dde6e6 100644 --- a/hv_vtbl.h +++ b/hv_vtbl.h @@ -53,6 +53,8 @@ struct hv_vtbl { STRLEN (*hvt_usedkeys)(pTHX_ HV *hv); /* Wraps hv_iterinit */ I32 (*hvt_iterinit)(pTHX_ HV *hv); + /* Wraps hv_iternext_flags */ + HE * (*hvt_iternext)(pTHX_ HV *hv, I32 flags); /* TODO also wrap all the iteration primitives! */ /* TODO research what other primitives are missing! */ -- Perl5 Master Repository
