-----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
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-----
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 *);
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 *))) {
}
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
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);
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);
}
/* 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
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... */
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);
{
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;
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);
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))
}
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;
break;
case SVt_PVHV:
+ dbg_printf(("# Found type HV\n"));
/* Is there anything in here? */
if (hv_iterinit((HV *)thing)) {
HE *temp_he;
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));
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);
projects / p5sagit/Devel-Size.git / commitdiff