From: Nicholas Clark Date: Wed, 4 May 2011 19:18:39 +0000 (+0200) Subject: Follow mg_obj, which points to an SV. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-Size.git;a=commitdiff_plain;h=b71309488bc6064635eabcac81bb327bb6a01b93;hp=72e2658d6b79549c2318c52724ff39fd6357c359 Follow mg_obj, which points to an SV. --- diff --git a/CHANGES b/CHANGES index 047d682..35b7d77 100644 --- a/CHANGES +++ b/CHANGES @@ -1,7 +1,8 @@ Revision history for Perl extension Devel::Size. 0.75_50 2011-05-04 nicholas - * The cores vtables are global and const, so don't count towards the size. + * The core's magic vtables are global constants, so aren't part of the size. + * Follow mg_obj 0.75 2011-05-04 nicholas [no changes] diff --git a/Size.xs b/Size.xs index ff5b4e4..d1ae900 100644 --- a/Size.xs +++ b/Size.xs @@ -311,7 +311,7 @@ cc_opclass(const OP * const o) /* Figure out how much magic is attached to the SV and return the size */ static void -magic_size(const SV * const thing, struct state *st) { +magic_size(pTHX_ const SV * const thing, struct state *st) { MAGIC *magic_pointer; /* Is there any? */ @@ -332,6 +332,7 @@ magic_size(const SV * const thing, struct state *st) { if (check_new(st, magic_pointer->mg_virtual)) { st->total_size += sizeof(MGVTBL); } + sv_size(aTHX_ st, magic_pointer->mg_obj, TOTAL_SIZE_RECURSION); /* Get the next in the chain */ magic_pointer = magic_pointer->mg_moremagic; @@ -560,7 +561,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, sv_size(aTHX_ st, SvRV_const(thing), recurse); else st->total_size += SvLEN(thing); - magic_size(thing, st); + magic_size(aTHX_ thing, st); TAG;break; #if PERL_VERSION <= 8 case SVt_PVBM: TAG; @@ -569,7 +570,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, sv_size(aTHX_ st, SvRV_const(thing), recurse); else st->total_size += SvLEN(thing); - magic_size(thing, st); + magic_size(aTHX_ thing, st); TAG;break; #endif case SVt_PVLV: TAG; @@ -578,7 +579,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, sv_size(aTHX_ st, SvRV_const(thing), recurse); else st->total_size += SvLEN(thing); - magic_size(thing, st); + magic_size(aTHX_ thing, st); TAG;break; /* How much space is dedicated to the array? Not counting the elements in the array, mind, just the array itself */ @@ -614,7 +615,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, complain about AvARYLEN() passing thing to it. */ sv_size(aTHX_ st, AvARYLEN(thing), recurse); #endif - magic_size(thing, st); + magic_size(aTHX_ thing, st); TAG;break; case SVt_PVHV: TAG; /* First the base struct */ @@ -641,11 +642,11 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, } } } - magic_size(thing, st); + magic_size(aTHX_ thing, st); TAG;break; case SVt_PVCV: TAG; st->total_size += sizeof(XPVCV); - magic_size(thing, st); + magic_size(aTHX_ thing, st); st->total_size += ((XPVIO *) SvANY(thing))->xpv_len; sv_size(aTHX_ st, (SV *)CvSTASH(thing), SOME_RECURSION); @@ -662,7 +663,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, TAG;break; case SVt_PVGV: TAG; - magic_size(thing, st); + magic_size(aTHX_ thing, st); st->total_size += sizeof(XPVGV); if(isGV_with_GP(thing)) { st->total_size += GvNAMELEN(thing); @@ -692,7 +693,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, TAG;break; case SVt_PVFM: TAG; st->total_size += sizeof(XPVFM); - magic_size(thing, st); + magic_size(aTHX_ thing, st); st->total_size += ((XPVIO *) SvANY(thing))->xpv_len; sv_size(aTHX_ st, (SV *)CvPADLIST(thing), SOME_RECURSION); sv_size(aTHX_ st, (SV *)CvOUTSIDE(thing), recurse); @@ -704,7 +705,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, TAG;break; case SVt_PVIO: TAG; st->total_size += sizeof(XPVIO); - magic_size(thing, st); + magic_size(aTHX_ thing, st); if (check_new(st, (SvPVX_const(thing)))) { st->total_size += ((XPVIO *) SvANY(thing))->xpv_cur; } diff --git a/t/magic.t b/t/magic.t index d0f5b73..08d7eb0 100644 --- a/t/magic.t +++ b/t/magic.t @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 7; +use Test::More tests => 11; use Devel::Size ':all'; require Tie::Scalar; @@ -31,3 +31,22 @@ require Tie::Scalar; cmp_ok($after_size, '>', $before_size, 'Still larger than initial size'); cmp_ok($after_size, '<', $compiled_size, 'size decreases due to unmagic'); } + +{ + my $string = 'Perl Rules'; + my $before_size = total_size($string); + cmp_ok($before_size, '>', length $string, + 'Our string has a non-zero length'); + tie $string, 'Tie::StdScalar'; + my $after_size = total_size($string); + cmp_ok($after_size, '>', $before_size, 'size increases due to magic'); + is($string, undef, 'No value yet'); + # This is defineately cheating, in that we're poking inside the + # implementation of Tie::StdScalar, but if we just write to $string, the way + # magic works, the (nice long) value is first written to the regular scalar, + # then picked up by the magic. So it grows, which defeats the purpose of the + # test. + ${tied $string} = 'X' x 1024; + cmp_ok(total_size($string), '>', $after_size + 1024, + 'the magic object is counted'); +}