From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 6 Oct 2009 07:24:08 +0000 (+0200)
Subject: Don't attempt UTF-8 cache assertion for SVs with invalid SvPVX() (eg overloaded)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ab8be49d36ac8fa0d20103344a61b3e7233fcba4;p=p5sagit%2Fp5-mst-13.2.git

Don't attempt UTF-8 cache assertion for SVs with invalid SvPVX() (eg overloaded)

Fixes RT 69422.

However, I'm not actually sure whether we should even be caching the results of
UTF-8 operations on overloading, given that nothing stops overloading returning
a different value every time it's called.
---

diff --git a/sv.c b/sv.c
index ee78fbc..077baff 100644
--- a/sv.c
+++ b/sv.c
@@ -6290,7 +6290,13 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN b
     }
     assert(cache);
 
-    if (PL_utf8cache < 0) {
+    if (PL_utf8cache < 0 && SvPOKp(sv)) {
+	/* SvPOKp() because it's possible that sv has string overloading, and
+	   therefore is a reference, hence SvPVX() is actually a pointer.
+	   This cures the (very real) symptoms of RT 69422, but I'm not actually
+	   sure whether we should even be caching the results of UTF-8
+	   operations on overloading, given that nothing stops overloading
+	   returning a different value every time it's called.  */
 	const U8 *start = (const U8 *) SvPVX_const(sv);
 	const STRLEN realutf8 = utf8_length(start, start + byte);
 
diff --git a/t/uni/overload.t b/t/uni/overload.t
index e4f4e13..d44d171 100644
--- a/t/uni/overload.t
+++ b/t/uni/overload.t
@@ -7,7 +7,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 208;
+use Test::More tests => 215;
 
 package UTF8Toggle;
 use strict;
@@ -264,6 +264,27 @@ foreach my $value ("\243", UTF8Toggle->new("\243")) {
     is (pack ("A/A", $value), pack ("A/A", "\243"));
 }
 
+foreach my $value ("\243", UTF8Toggle->new("\243")) {
+    my $v;
+    $v = substr $value, 0, 1;
+    is ($v, "\243");
+    $v = substr $value, 0, 1;
+    is ($v, "\243");
+    $v = substr $value, 0, 1;
+    is ($v, "\243");
+}
+
+{
+    package RT69422;
+    use overload '""' => sub { $_[0]->{data} }
+}
+
+{
+    my $text = bless { data => "\x{3075}" }, 'RT69422';
+    my $p = substr $text, 0, 1;
+    is ($p, "\x{3075}");
+}
+
 END {
     1 while -f $tmpfile and unlink $tmpfile || die "unlink '$tmpfile': $!";
 }