From: Tels Date: Sun, 24 Aug 2008 12:49:33 +0000 (-0800) Subject: import Devel-Size 0.71 from CPAN X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b76217297a5f92982c29177d97eb655b52d164eb;p=p5sagit%2FDevel-Size.git import Devel-Size 0.71 from CPAN git-cpan-module: Devel-Size git-cpan-version: 0.71 git-cpan-authorid: TELS git-cpan-file: authors/id/T/TE/TELS/devel/Devel-Size-0.71.tar.gz --- diff --git a/CHANGES b/CHANGES index 7d63b99..6b3cdb7 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,15 @@ Revision history for Perl extension Devel::Size. +0.71 2008-08-24 Tels 69 tests + * adapt patch from Reini Urban to fix failing RV under 5.10 and 5.11. AV + and HV were pushed directly onto the pending_array, and not the RV, + which caused #33530. So he rewrote the logic to deref the RV inside + the array traversal. Applied this with one small omission, which + caused test faiures. + * Fixed 5.11 RV/IV logic. (Thanx Reini Urban!) + * Removed one duplicate total_size arrayref test. (Thanx Reini Urban!) + * changed //printf to dbg_printf() (Thanx Reini again!) + 0.70 2008-08-23 Tels 69 tests * fix SEGFAULTS under v5.10 (Thanx Reini Urban!) * fix compilation under blead (Thanx Reini Urban!) @@ -10,7 +20,7 @@ Revision history for Perl extension Devel::Size. 0.69 2007-08-11 Tels 69 tests * fix compilation under Perl v5.9.5 and v5.10 (Thanx Steve Peters!) * clarify the license by specifying Perl v5.8.8's license - * smal doc fixes, add a README file + * small doc fixes, add a README file 0.68 2007-06-12 Tels 69 tests * remove a bit of duplicate code in op_size, the second instance diff --git a/META.yml b/META.yml index 4b00d6e..2015849 100644 --- a/META.yml +++ b/META.yml @@ -23,4 +23,4 @@ requires: perl: 5.006 resources: license: http://dev.perl.org/licenses/ -version: 0.70 +version: 0.71 diff --git a/Makefile.PL b/Makefile.PL index caf4519..7dfbe9c 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -16,7 +16,7 @@ requires 'perl' => 5.006; recommends 'Devel::Size::Report' => 0.11; -build_requires 'Test::More' => 0.42; +test_requires 'Test::More' => 0.42; license 'perl'; # from 5.8.8 diff --git a/README b/README index 9f99cf1..8bc0699 100644 --- a/README +++ b/README @@ -53,7 +53,7 @@ Please report bugs to: =head1 COPYRIGHT -Copyright (C) 2005 Dan Sugalski, Copyright (C) 2007 Tels +Copyright (C) 2005 Dan Sugalski, Copyright (C) 2007-2008 Tels This module is free software; you can redistribute it and/or modify it under the same terms as Perl v5.8.8. diff --git a/SIGNATURE b/SIGNATURE index cbd85a4..c410964 100644 --- a/SIGNATURE +++ b/SIGNATURE @@ -14,13 +14,13 @@ not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 -SHA1 b23dfc6cbcbc3169764e89224857923e58991a32 CHANGES +SHA1 71d646c70de21340e86b9756183693db519b50de CHANGES SHA1 e4296437ed0ab5559b250f6016d52c3b547d672e MANIFEST SHA1 6883c1a98abd5b1c049e389f831e939b79c13ba5 MANIFEST.SKIP -SHA1 0d8ddd17f26d90db4dc9f1ef004a7ce8a4df4a06 META.yml -SHA1 6c9a869815fa984597e1e2e2d8404bda9cac8c56 Makefile.PL -SHA1 e73e2ea830b69aefd7525f73b1fc06df4bf607f5 README -SHA1 c8500a5602417e1714f1f4e388fa24e83e9d357d Size.xs +SHA1 8596bb2ccbc20734b157e33cdb6d9ad4d6b4769b META.yml +SHA1 ae5f28dcf99f4e2880611ba504ba94bcbd5fdde9 Makefile.PL +SHA1 92434a102aaa3096b9bf747caeed1d97b0551f55 README +SHA1 5c399dee208b899e84659477127b19514b63b1ca Size.xs SHA1 5c9e093b0facca46d50e3c69d5569aa7a98db0b8 inc/Module/Install.pm SHA1 465acb50b9006ce61f58a7bd02d0bb029ddceaa6 inc/Module/Install/Base.pm SHA1 8356d82167fc00550b4a3ceea8bd852a374d7509 inc/Module/Install/Can.pm @@ -29,19 +29,19 @@ SHA1 37ed4ccd7aba10119e6f2993b8082674ce2e5961 inc/Module/Install/Makefile.pm SHA1 4aa1c578faad51f31e62bed7b28d3d42b88219c3 inc/Module/Install/Metadata.pm SHA1 d7529d795a1304c88253b26a9089913edf31ae5e inc/Module/Install/Win32.pm SHA1 2a74aba5a78e7ab2776382e42106ebe941c2ac28 inc/Module/Install/WriteAll.pm -SHA1 44bade83bb938b5ec9adeb68dcf343482ea5ccde lib/Devel/Size.pm -SHA1 362d6cb703b599a483563c84062e23b786c25d65 t/basic.t +SHA1 a18728b3efcecd37f62797a39ff9dd913bbb0e47 lib/Devel/Size.pm +SHA1 d0d8d563949313e09479186343c4107616abcab9 t/basic.t SHA1 dc638392e64661dd07deeba11f67e35650a6384a t/pod.t SHA1 f4ffad1e7160c51cefcd003f88e1deb1c897b344 t/pod_cov.t -SHA1 214b335fb4c2f01f164cae6a49ad738ba3b5dfbd t/recurse.t +SHA1 bd7fba2f87ec4e498f8ca6ace848a30b621e6c49 t/recurse.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.6 (GNU/Linux) -iQEVAwUBSK+5XXcLPEOTuEwVAQKRiQf+K3kgIRCgzfqJ34f2i2x8+S2jcvrlfGVH -0GfRNHGo1+7ZOPcrlTp/aS8lNp2ct+A4++oOf5xSKcOPdZ23nzosQXZzWoqXsZox -JMsG46EKnDtA53mNT8pdaDTBRAH4UWeMl1biZ+59XcjItENMujbVvWC/mnrLsZnD -/E+16wsaeJo0nCviPq8fsjzA17CiNXLy6Lzi+Ei9/V9nXMzg75J9ogaUVqT44oli -aqO05T5B7FJRCMjoB3k9l3s9Wk10YBxuc0XxBLrYqomgogf4sLRR5yx7S2otJfnF -TWO6WYiMuH820TdkGMeMXypzFlWuobt1LIMlkd1s8/QqbLAU/cJtzQ== -=gpOu +iQEVAwUBSLEr/ncLPEOTuEwVAQKonQf/Up2CEzLarhG5nO15sJGzJjd0etf+lpAg +et9OV+wG3rf6LXq1fgXY2dydPPNO0Yo9VM7b5nY59Kks5kavu/C/fl5QZ2irqejC +vSo4BCoEigRgzoy3YrPFW6WptxnGAM/CksZi+hN8H+IC8bQ1acdrZiCyYtab5kHC +H5HZ7iiHDfKXGA0x4YTnju138n62B0RIAXqTcwgSGaFvAu73T+8H0gzC5S9VwuFS +IeRcQWB3C8it4SGFGof/jAbTvwc1AckxLO+DwrhIi+04arGfkXCwZDGM5LJre5nN +yPTNDJ1NS26iYEzQM9rr2oNZ/MyWonsVEY0r4itPZ9GSoBIFG7WyEA== +=xTW5 -----END PGP SIGNATURE----- diff --git a/Size.xs b/Size.xs index c69c348..48b0ebf 100644 --- a/Size.xs +++ b/Size.xs @@ -5,6 +5,11 @@ static int regex_whine; static int fm_whine; +#if 0 && defined(DEBUGGING) +#define dbg_printf(x) printf x +#else +#define dbg_printf(x) +#endif #define carp puts UV thing_size(SV *, HV *); @@ -151,7 +156,7 @@ static int go_yell = 1; 64-bit machines) bytes of the address as the string we're using as the key */ IV check_new(HV *tracking_hash, const void *thing) { - if (NULL == thing) { + if (NULL == thing || NULL == tracking_hash) { return FALSE; } if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) { @@ -159,7 +164,6 @@ IV check_new(HV *tracking_hash, const void *thing) { } hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_yes, 0); return TRUE; - } /* Figure out how much magic is attached to the SV and return the @@ -330,9 +334,18 @@ UV op_size(OP *baseop, HV *tracking_hash) { basecop = (COP *)baseop; total_size += sizeof(struct cop); + /* Change 33656 by nicholas@mouse-mill on 2008/04/07 11:29:51 + Eliminate cop_label from struct cop by storing a label as the first + entry in the hints hash. Most statements don't have labels, so this + will save memory. Not sure how much. + The check below will be incorrect fail on bleadperls + before 5.11 @33656, but later than 5.10, producing slightly too + small memory sizes on these Perls. */ +#if (PERL_VERSION < 11) if (check_new(tracking_hash, basecop->cop_label)) { total_size += strlen(basecop->cop_label); } +#endif #ifdef USE_ITHREADS if (check_new(tracking_hash, basecop->cop_file)) { total_size += strlen(basecop->cop_file); @@ -400,12 +413,20 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) { much has been allocated */ case SVt_PV: total_size += sizeof(XPV); +#if (PERL_VERSION < 11) total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else + total_size += SvLEN(thing); +#endif break; /* A string with an integer part? */ case SVt_PVIV: total_size += sizeof(XPVIV); +#if (PERL_VERSION < 11) total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else + total_size += SvLEN(thing); +#endif if(SvOOK(thing)) { total_size += SvIVX(thing); } @@ -413,23 +434,39 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) { /* A scalar/string/reference with a float part? */ case SVt_PVNV: total_size += sizeof(XPVNV); +#if (PERL_VERSION < 11) total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else + total_size += SvLEN(thing); +#endif break; case SVt_PVMG: total_size += sizeof(XPVMG); +#if (PERL_VERSION < 11) total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else + total_size += SvLEN(thing); +#endif total_size += magic_size(thing, tracking_hash); break; #if PERL_VERSION <= 8 case SVt_PVBM: total_size += sizeof(XPVBM); +#if (PERL_VERSION < 11) total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else + total_size += SvLEN(thing); +#endif total_size += magic_size(thing, tracking_hash); break; #endif case SVt_PVLV: total_size += sizeof(XPVLV); +#if (PERL_VERSION < 11) total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else + total_size += SvLEN(thing); +#endif total_size += magic_size(thing, tracking_hash); break; /* How much space is dedicated to the array? Not counting the @@ -440,12 +477,12 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) { if (AvMAX(thing) != -1) { /* an array with 10 slots has AvMax() set to 9 - te 2007-04-22 */ total_size += sizeof(SV *) * (AvMAX(thing) + 1); - /* printf ("total_size: %li AvMAX: %li av_len: %i\n", total_size, AvMAX(thing), av_len(thing)); */ + dbg_printf(("total_size: %li AvMAX: %li av_len: $i\n", total_size, AvMAX(thing), av_len((AV*)thing))); } /* Add in the bits on the other side of the beginning */ - /* printf ("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n", - total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing )); */ + dbg_printf(("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n", + total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing ))); /* under Perl 5.8.8 64bit threading, AvARRAY(thing) was a pointer while AvALLOC was 0, resulting in grossly overstated sized for arrays. Technically, this shouldn't happen... */ @@ -637,13 +674,18 @@ CODE: go_yell = SvIV(warn_flag); } - /* If they passed us a reference then dereference it. This is the only way we can check the sizes of arrays and hashes */ +#if (PERL_VERSION < 11) if (SvOK(thing) && SvROK(thing)) { thing = SvRV(thing); } - +#else + if (SvROK(thing)) { + thing = SvRV(thing); + } +#endif + RETVAL = thing_size(thing, tracking_hash); /* Clean up after ourselves */ SvREFCNT_dec(tracking_hash); @@ -659,8 +701,9 @@ CODE: { SV *thing = orig_thing; /* Hash to track our seen pointers */ - HV *tracking_hash = newHV(); - AV *pending_array = newAV(); + HV *tracking_hash; + /* Array with things we still need to do */ + AV *pending_array; IV size = 0; SV *warn_flag; @@ -675,13 +718,18 @@ CODE: if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) { go_yell = SvIV(warn_flag); } - - /* If they passed us a reference then dereference it. This is the - only way we can check the sizes of arrays and hashes */ - if (SvOK(thing) && SvROK(thing)) { - thing = SvRV(thing); - } + /* init these after the go_yell above */ + tracking_hash = newHV(); + pending_array = newAV(); + + /* We cannot push HV/AV directly, only the RV. So deref it + later (see below for "*** dereference later") and adjust here for + the miscalculation. + This is the only way we can check the sizes of arrays and hashes. */ + if (SvROK(thing)) { + RETVAL -= thing_size(thing, NULL); + } /* Put it on the pending array */ av_push(pending_array, thing); @@ -691,16 +739,11 @@ CODE: thing = av_pop(pending_array); /* Process it if we've not seen it */ if (check_new(tracking_hash, thing)) { + dbg_printf(("# Found type %i at %p\n", SvTYPE(thing), thing)); /* Is it valid? */ if (thing) { - /* printf ("Found type %i at %p\n", SvTYPE(thing), thing); */ - /* Yes, it is. So let's check the type */ switch (SvTYPE(thing)) { - case SVt_RV: - av_push(pending_array, SvRV(thing)); - break; - /* fix for bug #24846 (Does not correctly recurse into references in a PVNV-type scalar) */ case SVt_PVNV: if (SvROK(thing)) @@ -709,8 +752,22 @@ CODE: } break; + /* this is the "*** dereference later" part - see above */ +#if (PERL_VERSION < 11) + case SVt_RV: +#else + case SVt_IV: +#endif + dbg_printf(("# Found RV\n")); + if (SvROK(thing)) { + dbg_printf(("# Found RV\n")); + av_push(pending_array, SvRV(thing)); + } + break; + case SVt_PVAV: { + dbg_printf(("# Found type AV\n")); /* Quick alias to cut down on casting */ AV *tempAV = (AV *)thing; SV **tempSV; @@ -734,6 +791,7 @@ CODE: break; case SVt_PVHV: + dbg_printf(("# Found type HV\n")); /* Is there anything in here? */ if (hv_iterinit((HV *)thing)) { HE *temp_he; @@ -744,6 +802,7 @@ CODE: break; case SVt_PVGV: + dbg_printf(("# Found type GV\n")); /* Run through all the pieces and push the ones with bits */ if (GvSV(thing)) { av_push(pending_array, (SV *)GvSV(thing)); @@ -769,8 +828,14 @@ CODE: size = thing_size(thing, tracking_hash); RETVAL += size; + } else { + /* check_new() returned false: */ +#ifdef DEVEL_SIZE_DEBUGGING + if (SvOK(sv)) printf("# Ignore ref copy 0x%x\n", sv); + else printf("# Ignore non-sv 0x%x\n", sv); +#endif } - } + } /* end while */ /* Clean up after ourselves */ SvREFCNT_dec(tracking_hash); diff --git a/lib/Devel/Size.pm b/lib/Devel/Size.pm index 326b991..ec98710 100644 --- a/lib/Devel/Size.pm +++ b/lib/Devel/Size.pm @@ -17,7 +17,7 @@ require DynaLoader; @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); @EXPORT = qw( ); -$VERSION = '0.70'; +$VERSION = '0.71'; bootstrap Devel::Size $VERSION; diff --git a/t/basic.t b/t/basic.t index 39390dd..308c667 100644 --- a/t/basic.t +++ b/t/basic.t @@ -8,7 +8,7 @@ my $tests; BEGIN { chdir 't' if -d 't'; - plan tests => 13; + plan tests => 12; use lib '../lib'; use lib '../blib/arch'; @@ -23,7 +23,7 @@ can_ok ('Devel::Size', qw/ Devel::Size->import( qw(size total_size) ); die ("Uhoh, test uses an outdated version of Devel::Size") - unless is ($Devel::Size::VERSION, '0.70', 'VERSION MATCHES'); + unless is ($Devel::Size::VERSION, '0.71', 'VERSION MATCHES'); ############################################################################# # some basic checks: @@ -45,7 +45,6 @@ my $size_1 = total_size(\@x); my $size_2 = total_size(\@y); ok ( $size_1 < $size_2, 'size() of array refs'); -ok (total_size(\@x) < total_size(\@y), 'total_size() of array refs'); # the arrays alone shouldn't be the same size $size_1 = size(\@x); diff --git a/t/recurse.t b/t/recurse.t index adb421c..2bf7a8d 100644 --- a/t/recurse.t +++ b/t/recurse.t @@ -29,7 +29,7 @@ can_ok ('Devel::Size', qw/ Devel::Size->import( qw(size total_size) ); die ("Uhoh, test uses an outdated version of Devel::Size") - unless is ($Devel::Size::VERSION, '0.70', 'VERSION MATCHES'); + unless is ($Devel::Size::VERSION, '0.71', 'VERSION MATCHES'); ############################################################################# # verify that pointer sizes in array slots are sensible: @@ -50,7 +50,9 @@ $ptr_size /= 4; my $hash = {}; $hash->{a} = 1; -is (total_size($hash), total_size( { a => undef } ) + total_size(1) - total_size(undef)); +is (total_size($hash), + total_size( { a => undef } ) + total_size(1) - total_size(undef), + 'assert hash and hash key size'); ############################################################################# # #24846 (Does not correctly recurse into references in a PVNV-type scalar)