From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 4 May 2011 20:24:58 +0000 (+0200)
Subject: Add the size of mg_len if mg_ptr is non-NULL.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d1888d0bf6f3c739044dc19ebd3114e3dc13bb47;p=p5sagit%2FDevel-Size.git

Add the size of mg_len if mg_ptr is non-NULL.

With special cases for UTF-8 caching magic, which abuses mg_len, and for
mg_len == HEf_SVKEY
---

diff --git a/CHANGES b/CHANGES
index 35b7d77..a6fefbe 100644
--- a/CHANGES
+++ b/CHANGES
@@ -2,7 +2,7 @@ Revision history for Perl extension Devel::Size.
 
 0.75_50 2011-05-04 nicholas
  * The core's magic vtables are global constants, so aren't part of the size.
- * Follow mg_obj
+ * Follow mg_obj and mg_ptr.
 
 0.75 2011-05-04 nicholas
  [no changes]
diff --git a/Size.xs b/Size.xs
index d1ae900..127152f 100644
--- a/Size.xs
+++ b/Size.xs
@@ -333,6 +333,21 @@ magic_size(pTHX_ const SV * const thing, struct state *st) {
           st->total_size += sizeof(MGVTBL);
         }
 	sv_size(aTHX_ st, magic_pointer->mg_obj, TOTAL_SIZE_RECURSION);
+	if (magic_pointer->mg_len == HEf_SVKEY) {
+	    sv_size(aTHX_ st, (SV *)magic_pointer->mg_ptr, TOTAL_SIZE_RECURSION);
+	}
+#if defined(PERL_MAGIC_utf8) && defined (PERL_MAGIC_UTF8_CACHESIZE)
+	else if (magic_pointer->mg_type == PERL_MAGIC_utf8) {
+	    if (check_new(st, magic_pointer->mg_ptr)) {
+		st->total_size += PERL_MAGIC_UTF8_CACHESIZE * 2 * sizeof(STRLEN);
+	    }
+	}
+#endif
+	else if (magic_pointer->mg_len > 0) {
+	    if (check_new(st, magic_pointer->mg_ptr)) {
+		st->total_size += magic_pointer->mg_len;
+	    }
+	}
 
         /* Get the next in the chain */
         magic_pointer = magic_pointer->mg_moremagic;
diff --git a/t/magic.t b/t/magic.t
index 08d7eb0..8dfb6de 100644
--- a/t/magic.t
+++ b/t/magic.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 11;
+use Test::More tests => 18;
 use Devel::Size ':all';
 require Tie::Scalar;
 
@@ -50,3 +50,23 @@ require Tie::Scalar;
     cmp_ok(total_size($string), '>', $after_size + 1024,
 	   'the magic object is counted');
 }
+
+SKIP: {
+    skip("v-strings didn't use magic before 5.8.1", 2) if $] < 5.008001;
+    my $v = eval 'v' . (0 x 1024);
+    is($v, "\0", 'v-string is \0');
+    cmp_ok(total_size($v), '>', 1024, 'total_size follows MG_PTR');
+}
+
+SKIP: {
+    skip("no UTF-8 caching before 5.8.1", 5) if $] < 5.008001;
+    my $string = "a\x{100}b";
+    my $before_size = total_size($string);
+    cmp_ok($before_size, '>', 0, 'Our string has a non-zero length');
+    is(length $string, 3, 'length is sane');
+    my $with_magic = total_size($string);
+    cmp_ok($with_magic, '>', $before_size, 'UTF-8 caching fired and counted');
+    is(index($string, "b"), 2, 'b is where we expect it');
+    cmp_ok(total_size($string), '>', $with_magic,
+	   'UTF-8 caching length table now present');
+}