X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=9d2595f6a92e0d403fb5a5704e99e79b2a047b53;hb=1dc48e0232d5e1e7ab09019a7e4801927094dcd6;hp=5bc734977a8b148954614f497974e2629a0b50e6;hpb=23f1ca44d37416af3607cb447a1cb56c28dfb289;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index 5bc7349..9d2595f 100644 --- a/dump.c +++ b/dump.c @@ -194,6 +194,11 @@ Perl_sv_peek(pTHX_ SV *sv) sv_catpv(t, "("); unref++; } + else if (DEBUG_R_TEST && SvREFCNT(sv) > 1) { + Perl_sv_catpvf(aTHX_ t, "<%"UVuf">", (UV)SvREFCNT(sv)); + } + + if (SvROK(sv)) { sv_catpv(t, "\\"); if (SvCUR(t) + unref > 10) { @@ -273,7 +278,7 @@ Perl_sv_peek(pTHX_ SV *sv) Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, 127)); Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127)); if (SvUTF8(sv)) - Perl_sv_catpvf(aTHX_ t, " [UTF8]"); + Perl_sv_catpvf(aTHX_ t, " [UTF8]"); SvREFCNT_dec(tmp); } } @@ -290,7 +295,7 @@ Perl_sv_peek(pTHX_ SV *sv) } else sv_catpv(t, "()"); - + finish: if (unref) { while (unref--) @@ -470,7 +475,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) if (o->op_private & OPpENTERSUB_HASTARG) sv_catpv(tmpsv, ",HASTARG"); } - else + else switch (o->op_private & OPpDEREF) { case OPpDEREF_SV: sv_catpv(tmpsv, ",SV"); @@ -777,7 +782,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, "SV = 0\n"); return; } - + flags = SvFLAGS(sv); type = SvTYPE(sv); @@ -823,6 +828,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (CvCONST(sv)) sv_catpv(d, "CONST,"); if (CvNODEBUG(sv)) sv_catpv(d, "NODEBUG,"); if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,"); + if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,"); + if (CvMETHOD(sv)) sv_catpv(d, "METHOD,"); break; case SVt_PVHV: if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,"); @@ -999,7 +1006,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo SV** elt = av_fetch((AV*)sv,count,0); Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count); - if (elt) + if (elt) do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim); } } @@ -1037,15 +1044,24 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo } } PerlIO_putc(file, ')'); - /* Now calculate quality wrt theoretical value */ + /* The "quality" of a hash is defined as the total number of + comparisons needed to access every element once, relative + to the expected number needed for a random hash. + + The total number of comparisons is equal to the sum of + the squares of the number of entries in each backet. + For a random hash of n keys into k backets, the expected + value is + n + n(n-1)/2k + */ + for (i = max; i > 0; i--) { /* Precision: count down. */ sum += freq[i] * i * i; } while ((keys = keys >> 1)) pow2 = pow2 << 1; - /* Approximate by Poisson distribution */ theoret = HvKEYS(sv); - theoret += theoret * theoret/pow2; + theoret += theoret * (theoret-1)/pow2; PerlIO_putc(file, '\n'); Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100); } @@ -1115,7 +1131,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (SvPOK(pname[ix])) Perl_dump_indent(aTHX_ level, /* %5d below is enough whitespace. */ - file, + file, "%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n", (int)ix, PTR2UV(ppad[ix]), SvFAKE(pname[ix]) ? "FAKE " : "", @@ -1126,7 +1142,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo } { CV *outside = CvOUTSIDE(sv); - Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n", + Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n", PTR2UV(outside), (!outside ? "null" : CvANON(outside) ? "ANON"