Don't attempt UTF-8 cache assertion for SVs with invalid SvPVX() (eg overloaded)
authorNicholas Clark <nick@ccl4.org>
Tue, 6 Oct 2009 07:24:08 +0000 (09:24 +0200)
committerNicholas Clark <nick@ccl4.org>
Tue, 6 Oct 2009 07:24:08 +0000 (09:24 +0200)
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.

sv.c
t/uni/overload.t

diff --git a/sv.c b/sv.c
index ee78fbc..077baff 100644 (file)
--- 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);
 
index e4f4e13..d44d171 100644 (file)
@@ -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': $!";
 }