Handle shared hash key scalars correctly.

diff --git a/CHANGES b/CHANGES
index b3668a2..61fcacc 100644 (file)
--- a/CHANGES
+++ b/CHANGES
@@ -2,6 +2,7 @@ Revision history for Perl extension Devel::Size.
 
 0.76_50 2011-05-12 nicholas
  * Split out HEK size calculation into hek_size(). Add the shared HE overhead.
+ * Handle shared hash key scalars correctly.
 
 0.76 2011-05-11 nicholas
  * Just fix the version number in the line below.

diff --git a/Size.xs b/Size.xs
index 5b8aba8..d122757 100644 (file)
--- a/Size.xs
+++ b/Size.xs
@@ -17,6 +17,17 @@
 #ifndef SvOOK_offset
 #  define SvOOK_offset(sv, len) STMT_START { len = SvIVX(sv); } STMT_END
 #endif
+#ifndef SvIsCOW
+#  define SvIsCOW(sv)           ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \
+                                    (SVf_FAKE | SVf_READONLY))
+#endif
+#ifndef SvIsCOW_shared_hash
+#  define SvIsCOW_shared_hash(sv)   (SvIsCOW(sv) && SvLEN(sv) == 0)
+#endif
+#ifndef SvSHARED_HEK_FROM_PV
+#  define SvSHARED_HEK_FROM_PV(pvx) \
+        ((struct hek*)(pvx - STRUCT_OFFSET(struct hek, hek_key)))
+#endif
 
 #if PERL_VERSION < 6
 #  define PL_opargs opargs
@@ -820,6 +831,8 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
   freescalar:
     if(recurse && SvROK(thing))
        sv_size(aTHX_ st, SvRV_const(thing), recurse);
+    else if (SvIsCOW_shared_hash(thing))
+       hek_size(aTHX_ st, SvSHARED_HEK_FROM_PV(SvPVX(thing)), 1);
     else
        st->total_size += SvLEN(thing);
 

diff --git a/t/basic.t b/t/basic.t
index ff6478a..80a03ec 100644 (file)
--- a/t/basic.t
+++ b/t/basic.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 19;
+use Test::More tests => 26;
 use strict;
 use Devel::Size qw(size total_size);
 
@@ -123,3 +123,25 @@ foreach(['undef', total_size(undef)],
        "Size doesn't change because OOK is used");
     cmp_ok(length $uurk, '<', $before_size, 'but string is shorter');
 }
+
+sub shared_hash_keys {
+    my %h = @_;
+    my $one = total_size([keys %h]);
+    cmp_ok($one, '>', 0, 'Size of one entry is sane');
+    my $two =  total_size([keys %h, keys %h]);
+    cmp_ok($two, '>', $one, 'Two take more space than one');
+    my $increment = $two - $one;
+    is(total_size([keys %h, keys %h, keys %h]), $one + 2 * $increment,
+                'Linear size increase for three');
+    return $increment;
+}
+
+{
+    my $small = shared_hash_keys(Perl => 'Rules');
+    my $big = shared_hash_keys('x' x 1024, '');
+ SKIP: {
+       skip("[keys %h] doesn't copy as shared hash key scalars prior to 5.10.0",
+            1) if $] < 5.010;
+       is ($small, $big, 'The "shared" part of shared hash keys is spotted');
+    }
+}