r24580 - in /branches/upstream/libdevel-size-perl/current: CHANGES META.yml Makefile.PL README SIGNATURE Size.xs lib/Devel/Size.pm t/basic.t t/recurse.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sun Aug 24 18:41:20 UTC 2008
Author: gregoa
Date: Sun Aug 24 18:41:18 2008
New Revision: 24580
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=24580
Log:
[svn-upgrade] Integrating new upstream version, libdevel-size-perl (0.71)
Modified:
branches/upstream/libdevel-size-perl/current/CHANGES
branches/upstream/libdevel-size-perl/current/META.yml
branches/upstream/libdevel-size-perl/current/Makefile.PL
branches/upstream/libdevel-size-perl/current/README
branches/upstream/libdevel-size-perl/current/SIGNATURE
branches/upstream/libdevel-size-perl/current/Size.xs
branches/upstream/libdevel-size-perl/current/lib/Devel/Size.pm
branches/upstream/libdevel-size-perl/current/t/basic.t
branches/upstream/libdevel-size-perl/current/t/recurse.t
Modified: branches/upstream/libdevel-size-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-size-perl/current/CHANGES?rev=24580&op=diff
==============================================================================
--- branches/upstream/libdevel-size-perl/current/CHANGES (original)
+++ branches/upstream/libdevel-size-perl/current/CHANGES Sun Aug 24 18:41:18 2008
@@ -1,4 +1,14 @@
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!)
@@ -10,7 +20,7 @@
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
Modified: branches/upstream/libdevel-size-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-size-perl/current/META.yml?rev=24580&op=diff
==============================================================================
--- branches/upstream/libdevel-size-perl/current/META.yml (original)
+++ branches/upstream/libdevel-size-perl/current/META.yml Sun Aug 24 18:41:18 2008
@@ -23,4 +23,4 @@
perl: 5.006
resources:
license: http://dev.perl.org/licenses/
-version: 0.70
+version: 0.71
Modified: branches/upstream/libdevel-size-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-size-perl/current/Makefile.PL?rev=24580&op=diff
==============================================================================
--- branches/upstream/libdevel-size-perl/current/Makefile.PL (original)
+++ branches/upstream/libdevel-size-perl/current/Makefile.PL Sun Aug 24 18:41:18 2008
@@ -16,7 +16,7 @@
recommends 'Devel::Size::Report' => 0.11;
-build_requires 'Test::More' => 0.42;
+test_requires 'Test::More' => 0.42;
license 'perl'; # from 5.8.8
Modified: branches/upstream/libdevel-size-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-size-perl/current/README?rev=24580&op=diff
==============================================================================
--- branches/upstream/libdevel-size-perl/current/README (original)
+++ branches/upstream/libdevel-size-perl/current/README Sun Aug 24 18:41:18 2008
@@ -53,7 +53,7 @@
=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.
Modified: branches/upstream/libdevel-size-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-size-perl/current/SIGNATURE?rev=24580&op=diff
==============================================================================
--- branches/upstream/libdevel-size-perl/current/SIGNATURE (original)
+++ branches/upstream/libdevel-size-perl/current/SIGNATURE Sun Aug 24 18:41:18 2008
@@ -14,13 +14,13 @@
-----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 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-----
Modified: branches/upstream/libdevel-size-perl/current/Size.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-size-perl/current/Size.xs?rev=24580&op=diff
==============================================================================
--- branches/upstream/libdevel-size-perl/current/Size.xs (original)
+++ branches/upstream/libdevel-size-perl/current/Size.xs Sun Aug 24 18:41:18 2008
@@ -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 @@
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 @@
}
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 @@
basecop = (COP *)baseop;
total_size += sizeof(struct cop);
+ /* Change 33656 by nicholas at 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 @@
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 @@
/* 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 @@
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 @@
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 @@
{
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 @@
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 @@
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 @@
}
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 @@
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 @@
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 @@
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);
Modified: branches/upstream/libdevel-size-perl/current/lib/Devel/Size.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-size-perl/current/lib/Devel/Size.pm?rev=24580&op=diff
==============================================================================
--- branches/upstream/libdevel-size-perl/current/lib/Devel/Size.pm (original)
+++ branches/upstream/libdevel-size-perl/current/lib/Devel/Size.pm Sun Aug 24 18:41:18 2008
@@ -17,7 +17,7 @@
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@EXPORT = qw( );
-$VERSION = '0.70';
+$VERSION = '0.71';
bootstrap Devel::Size $VERSION;
Modified: branches/upstream/libdevel-size-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-size-perl/current/t/basic.t?rev=24580&op=diff
==============================================================================
--- branches/upstream/libdevel-size-perl/current/t/basic.t (original)
+++ branches/upstream/libdevel-size-perl/current/t/basic.t Sun Aug 24 18:41:18 2008
@@ -8,7 +8,7 @@
BEGIN
{
chdir 't' if -d 't';
- plan tests => 13;
+ plan tests => 12;
use lib '../lib';
use lib '../blib/arch';
@@ -23,7 +23,7 @@
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_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);
Modified: branches/upstream/libdevel-size-perl/current/t/recurse.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-size-perl/current/t/recurse.t?rev=24580&op=diff
==============================================================================
--- branches/upstream/libdevel-size-perl/current/t/recurse.t (original)
+++ branches/upstream/libdevel-size-perl/current/t/recurse.t Sun Aug 24 18:41:18 2008
@@ -29,7 +29,7 @@
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 @@
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)
More information about the Pkg-perl-cvs-commits
mailing list