From: Chip Salzenberg <chip@pobox.com>
Date: Tue, 8 Dec 2009 08:17:05 +0000 (-0800)
Subject: utf8cache test: Hugo asks, and I provide. Merry Christmas
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fa421ef92a7e8058000e870bee22bbe09d7055c9;p=p5sagit%2Fp5-mst-13.2.git

utf8cache test: Hugo asks, and I provide. Merry Christmas
---

diff --git a/t/op/utf8cache.t b/t/op/utf8cache.t
new file mode 100644
index 0000000..df04f54
--- /dev/null
+++ b/t/op/utf8cache.t
@@ -0,0 +1,41 @@
+#!./perl
+# Test for malfunctions of utf8 cache
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+unless (eval { require Devel::Peek }) {
+    print "# Without Devel::Peek, never mind\n";
+    print "1..0\n";
+    exit;
+}
+print "1..1\n";
+
+my $pid = open CHILD, '-|';
+die "kablam: $!\n" unless defined $pid;
+unless ($pid) {
+    open STDERR, ">&STDOUT";
+    $a = "hello \x{1234}";
+    for (1..2) {
+        bar(substr($a, $_, 1));
+    }
+    sub bar {
+        $_[0] = "\x{4321}";
+        Devel::Peek::Dump($_[0]);
+    }
+    exit;
+}
+
+{ local $/; $_ = <CHILD> }
+
+my $utf8magic = qr{ ^ \s+ MAGIC \s = .* \n
+                      \s+ MG_VIRTUAL \s = .* \n
+                      \s+ MG_TYPE \s = \s PERL_MAGIC_utf8 .* \n
+                      \s+ MG_LEN \s = .* \n }xm;
+
+if (m{ $utf8magic $utf8magic }x) {
+    print "not ";
+}
+print "ok 1\n";