Correctly handle SvOOK scalars. 5.12 and later don't use SvIVX().

diff --git a/CHANGES b/CHANGES
index 3d487da..f221c7f 100644 (file)
--- a/CHANGES
+++ b/CHANGES
@@ -2,6 +2,7 @@ Revision history for Perl extension Devel::Size.
 
 0.72_52 2011-05-09 nicholas
  * Use a table for SV body sizes. These incorporate the space saving post 5.8.x
+ * Correctly handle SvOOK scalars. 5.12 and later don't use SvIVX().
 
 0.75_51 2011-05-05 nicholas
  * Only use a static array of vtables on gcc.

diff --git a/Size.xs b/Size.xs
index c77a391..913467b 100644 (file)
--- a/Size.xs
+++ b/Size.xs
@@ -12,6 +12,9 @@
 #ifndef SvRV_const
 #  define SvRV_const(rv) SvRV(rv)
 #endif
+#ifndef SvOOK_offset
+#  define SvOOK_offset(sv, len) STMT_START { len = SvIVX(sv); } STMT_END
+#endif
 
 #ifdef _MSC_VER 
 /* "structured exception" handling is a Microsoft extension to C and C++.
@@ -760,7 +763,9 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
        st->total_size += SvLEN(thing);
 
     if(SvOOK(thing)) {
-        st->total_size += SvIVX(thing);
+       STRLEN len;
+       SvOOK_offset(thing, len);
+       st->total_size += len;
     }
     TAG;break;
 

diff --git a/t/basic.t b/t/basic.t
index 980899b..e39799a 100644 (file)
--- a/t/basic.t
+++ b/t/basic.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 16;
+use Test::More tests => 19;
 use strict;
 use Devel::Size qw(size total_size);
 use Scalar::Util qw(weaken);
@@ -98,3 +98,18 @@ foreach(['undef', total_size(undef)],
     is($size, 0,
        "PL_sv_$name is interpeter wide, so not counted as part of the structure's size");
 }
+
+{
+    # SvOOK stuff
+    my $uurk = "Perl Rules";
+    # This may upgrade the scalar:
+    $uurk =~ s/Perl//;
+    $uurk =~ s/^/Perl/;
+    my $before_size = total_size($uurk);
+    my $before_length = length $uurk;
+    cmp_ok($before_size, '>', $before_length, 'Size before is sane');
+    $uurk =~ s/Perl //;
+    is(total_size($uurk), $before_size,
+       "Size doesn't change because OOK is used");
+    cmp_ok(length $uurk, '<', $before_size, 'but string is shorter');
+}