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