In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e1a7ec8d453649a65aea34af90c3042a5137191e?hp=7707f065b38b724eae5cbcb7ea8096ab1a2971ff>
- Log ----------------------------------------------------------------- commit e1a7ec8d453649a65aea34af90c3042a5137191e Author: Yves Orton <[email protected]> Date: Sun Mar 24 11:48:12 2013 +0100 improve how Devel::Peek::Dump handles iterator information * If the hash is not OOK omit any iterator status information instead of showing -1/NULL * If the hash is OOK then add the RAND value from the iterator and if the LASTRAND is not the same show it too * Tweak tests to test the above. M dump.c M ext/Devel-Peek/t/Peek.t M hv.h commit ff20b672a2557d27fcb80d597224fa0c24e43f73 Author: Yves Orton <[email protected]> Date: Sun Mar 24 11:47:22 2013 +0100 Add a commented out warning and a way for diag.t to ignore it M hv.c M t/porting/diag.t commit 3a71429411c9f019441035c9f35ea66b0f169acc Author: Yves Orton <[email protected]> Date: Sun Mar 24 11:46:22 2013 +0100 improve iterator randomization M hv.c ----------------------------------------------------------------------- Summary of changes: dump.c | 12 ++++++++++-- ext/Devel-Peek/t/Peek.t | 17 +++++------------ hv.c | 16 +++++++++++++--- hv.h | 3 +++ t/porting/diag.t | 2 ++ 5 files changed, 33 insertions(+), 17 deletions(-) diff --git a/dump.c b/dump.c index fcc63fc..dd0e305 100644 --- a/dump.c +++ b/dump.c @@ -1801,8 +1801,16 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvUSEDKEYS(sv)); Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)HvFILL(sv)); Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv)); - Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv)); - Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv))); + if (SvOOK(sv)) { + Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER_get(sv)); + Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv))); + Perl_dump_indent(aTHX_ level, file, " RAND = 0x%"UVxf, (UV)HvRAND_get(sv)); + if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) { + PerlIO_printf(file, " (LAST = 0x%"UVxf")\n", (UV)HvLASTRAND_get(sv)); + } else { + PerlIO_putc(file, '\n'); + } + } { MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab); if (mg && mg->mg_obj) { diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 912bf8c..1debcb5 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -250,8 +250,6 @@ do_test('reference to hash', KEYS = 1 FILL = 1 MAX = 7 - RITER = -1 - EITER = 0x0 Elt "123" HASH = $ADDR' . $c_pattern, '', $] > 5.009 && $] < 5.015 @@ -400,9 +398,7 @@ do_test('reference to blessed hash', ARRAY = 0x0 KEYS = 0 FILL = 0 - MAX = 7 - RITER = -1 - EITER = 0x0', '', + MAX = 7', '', $] > 5.009 ? $] >= 5.015 ? 0 @@ -477,8 +473,6 @@ do_test('reference to hash containing Unicode', KEYS = 1 FILL = 1 MAX = 7 - RITER = -1 - EITER = $ADDR Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR SV = PV\\($ADDR\\) at $ADDR REFCNT = 1 @@ -508,8 +502,6 @@ do_test('reference to hash containing Unicode', KEYS = 1 FILL = 1 MAX = 7 - RITER = -1 - EITER = $ADDR Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR SV = PV\\($ADDR\\) at $ADDR REFCNT = 1 @@ -723,9 +715,7 @@ do_test('blessing to a class with embedded NUL characters', ARRAY = $ADDR KEYS = 0 FILL = 0 - MAX = 7 - RITER = -1 - EITER = 0x0', '', + MAX = 7', '', $] > 5.009 ? $] >= 5.015 ? 0 @@ -749,6 +739,7 @@ do_test('ENAME on a stash', MAX = 7 RITER = -1 EITER = 0x0 + RAND = $ADDR NAME = "RWOM" ENAME = "RWOM" # $] > 5.012 '); @@ -772,6 +763,7 @@ do_test('ENAMEs on a stash', MAX = 7 RITER = -1 EITER = 0x0 + RAND = $ADDR NAME = "RWOM" NAMECOUNT = 2 # $] > 5.012 ENAME = "RWOM", "KLANK" # $] > 5.012 @@ -797,6 +789,7 @@ do_test('ENAMEs on a stash with no NAME', MAX = 7 RITER = -1 EITER = 0x0 + RAND = $ADDR NAMECOUNT = -3 # $] > 5.012 ENAME = "RWOM", "KLANK" # $] > 5.012 '); diff --git a/hv.c b/hv.c index 0821841..7d69fe4 100644 --- a/hv.c +++ b/hv.c @@ -792,10 +792,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, * making it harder to see if there is a collision. We also * reset the iterator randomizer if there is one. */ - if (SvOOK(hv)) - HvAUX(hv)->xhv_rand= (U32)PL_hash_rand_bits; PL_hash_rand_bits += (PTRV)entry ^ hash; /* we don't bother to use ptr_hash here */ - PL_hash_rand_bits= ROTL_UV(PL_hash_rand_bits,1); if ( !*oentry || (PL_hash_rand_bits & 1) ) { HeNEXT(entry) = *oentry; *oentry = entry; @@ -803,6 +800,19 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, HeNEXT(entry) = HeNEXT(*oentry); HeNEXT(*oentry) = entry; } + PL_hash_rand_bits= ROTL_UV(PL_hash_rand_bits,1); + if (SvOOK(hv)) { + /* Currently this makes various tests warn in annoying ways. + * So Silenced for now. - Yves | bogus end of comment =>* / + if (HvAUX(hv)->xhv_riter != -1) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "[TESTING] Inserting into a hash during each() traversal results in undefined behavior" + pTHX__FORMAT + pTHX__VALUE); + } + */ + HvAUX(hv)->xhv_rand= (U32)PL_hash_rand_bits; + } if (val == &PL_sv_placeholder) HvPLACEHOLDERS(hv)++; diff --git a/hv.h b/hv.h index e6b9bb8..61bc5bd 100644 --- a/hv.h +++ b/hv.h @@ -226,6 +226,9 @@ C<SV*>. #define HvEITER_set(hv,e) Perl_hv_eiter_set(aTHX_ MUTABLE_HV(hv), e) #define HvRITER_get(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_riter : -1) #define HvEITER_get(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_eiter : NULL) +#define HvRAND_get(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_rand : 0) +#define HvLASTRAND_get(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_last_rand : 0) + #define HvNAME(hv) HvNAME_get(hv) #define HvNAMELEN(hv) HvNAMELEN_get(hv) #define HvENAME(hv) HvENAME_get(hv) diff --git a/t/porting/diag.t b/t/porting/diag.t index 2473e65..bcf853e 100644 --- a/t/porting/diag.t +++ b/t/porting/diag.t @@ -359,6 +359,8 @@ sub check_file { # inside an #if 0 block. next if $name eq 'SKIPME'; + next if $name=~/\[TESTING\]/; # ignore these as they are works in progress + check_message(standardize($name),$codefn,$severity,$categories); } } -- Perl5 Master Repository
