From 72de20cdcc84ae35e0d8a55c7a92950fece19347 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 28 Jun 2011 15:20:56 +0200
Subject: For shorter strings, store C<study>'s data as U8s or U16s, instead of
 U32s.

The assumption is that most studied strings are fairly short, hence the pain
of the extra code is worth it, given the memory savings.
80 character string, 336 bytes as U8, down from 1344 as U32
800 character string, 2112 bytes as U16, down from 4224 as U32
---
 ext/Devel-Peek/t/Peek.t | 57 +++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 53 insertions(+), 4 deletions(-)

(limited to 'ext')

diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index 642d34c09b..d582a8f03c 100644
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -874,9 +874,10 @@ unless ($Config{useithreads}) {
   LEN = \d+
   MAGIC = $ADDR
     MG_VIRTUAL = &PL_vtbl_regexp
+    MG_PRIVATE = 1
     MG_TYPE = PERL_MAGIC_study\\(G\\)
-    MG_LEN = 1044
-    MG_PTR = $ADDR "\\\\377\\\\377\\\\377\\\\377.*"
+    MG_LEN = 261
+    MG_PTR = $ADDR "\\\\377.*"
 ';
 
     is(study beer, 1, "Our studies were successful");
@@ -903,10 +904,58 @@ unless ($Config{useithreads}) {
   LEN = \d+
   MAGIC = $ADDR
     MG_VIRTUAL = &PL_vtbl_regexp
+    MG_PRIVATE = 1
     MG_TYPE = PERL_MAGIC_study\\(G\\)
-    MG_LEN = 1040
-    MG_PTR = $ADDR "\\\\377\\\\377\\\\377\\\\377.*"
+    MG_LEN = 260
+    MG_PTR = $ADDR "\\\\377.*"
 ');
 }
 
+{
+  my %z;
+  foreach (1, 254, 255, 65534, 65535) {
+    $z{$_} = "\0" x $_;
+    study $z{$_};
+  }
+  do_test('short studied representation', $z{1},
+'SV = PVMG\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(SMG,POK,pPOK,SCREAM\\)
+  IV = 0
+  NV = 0
+  PV = $ADDR "\\\\0"\\\0
+  CUR = 1
+  LEN = \d+
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_regexp
+    MG_PRIVATE = 1
+    MG_TYPE = PERL_MAGIC_study\\(G\\)
+    MG_LEN = 257
+    MG_PTR = $ADDR "\\\\0(?:\\\\377){256}"
+');
+
+  foreach ([254, 1], [255, 2], [65534, 2], [65535, 4]
+	  ) {
+    my ($length, $bytes) = @$_;
+    my $quant = $length <= 32766 ? "{$length}" : '*';
+    do_test("studied representation for length $length", $z{$length},
+	    sprintf 
+'SV = PVMG\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(SMG,POK,pPOK,SCREAM\\)
+  IV = 0
+  NV = 0
+  PV = $ADDR "(?:\\\\0)%s"\\\0
+  CUR = %d
+  LEN = \d+
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_regexp
+    MG_PRIVATE = %d
+    MG_TYPE = PERL_MAGIC_study\\(G\\)
+    MG_LEN = %d
+    MG_PTR = $ADDR "\\\\0.*\\\\377"
+', $quant, $length, $bytes, (256 + $length) * $bytes);
+  }
+}
+
 done_testing();
-- 
cgit v1.2.1