From aec43834c1e29d84920b6d8a41a80fb6c2363487 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Thu, 27 Sep 2012 21:29:33 -0700
Subject: [PATCH] Stop pos from panicking when overloading changes UTF8ness

This touches on issues raised in tickets #114410 and #114690.

If the UTF8ness of an overloaded string changes with each call, it
will make magic_setpos panic if it tries to stringify the SV multiple
times.  We have to avoid any sv-specific utf8 length functions when
it comes to overloading.  And we should do the same thing for gmagic,
too, to avoid creating caches that will shortly be invalidated.

The test class is very closely based on code written by Nicholas Clark
in a response to #114410.
---
 mg.c             |  7 ++++---
 sv.h             | 11 +++++++++++
 t/op/utf8cache.t | 34 +++++++++++++++++++++++++++++++++-
 3 files changed, 48 insertions(+), 4 deletions(-)

diff --git a/mg.c b/mg.c
index db9b4ee..4ba96a4 100644
--- a/mg.c
+++ b/mg.c
@@ -2157,6 +2157,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     STRLEN len;
     STRLEN ulen = 0;
     MAGIC* found;
+    const char *s;
 
     PERL_ARGS_ASSERT_MAGIC_SETPOS;
     PERL_UNUSED_ARG(mg);
@@ -2179,12 +2180,12 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 	found->mg_len = -1;
 	return 0;
     }
-    len = SvPOK_nog(lsv) ? SvCUR(lsv) : sv_len(lsv);
+    s = SvPV_const(lsv, len);
 
     pos = SvIV(sv);
 
     if (DO_UTF8(lsv)) {
-	ulen = sv_len_utf8_nomg(lsv);
+	ulen = sv_or_pv_len_utf8(lsv, s, len);
 	if (ulen)
 	    len = ulen;
     }
@@ -2198,7 +2199,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 	pos = len;
 
     if (ulen) {
-	pos = sv_pos_u2b_flags(lsv, pos, 0, 0);
+	pos = sv_or_pv_pos_u2b(lsv, s, pos);
     }
 
     found->mg_len = pos;
diff --git a/sv.h b/sv.h
index 18d3015..2ac6c50 100644
--- a/sv.h
+++ b/sv.h
@@ -1818,6 +1818,17 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect
 	    sv_catsv_nomg(dsv, nsv);			\
 	} STMT_END
 
+#ifdef PERL_CORE
+# define sv_or_pv_len_utf8(sv, pv, bytelen)	      \
+    (SvGAMAGIC(sv)				       \
+	? utf8_length((U8 *)(pv), (U8 *)(pv)+(bytelen))	\
+	: sv_len_utf8(sv))
+# define sv_or_pv_pos_u2b(sv, pv, pos)			 \
+    (SvGAMAGIC(sv)					  \
+	? (STRLEN)(utf8_hop((U8 *)(pv), pos) - (U8 *)(pv)) \
+	: sv_pos_u2b_flags(sv,pos,0,0))
+#endif
+
 /*
 =for apidoc Am|SV*|newRV_inc|SV* sv
 
diff --git a/t/op/utf8cache.t b/t/op/utf8cache.t
index a9e88a6..2d10332 100644
--- a/t/op/utf8cache.t
+++ b/t/op/utf8cache.t
@@ -9,7 +9,7 @@ BEGIN {
 
 use strict;
 
-plan(tests => 5);
+plan(tests => 7);
 
 SKIP: {
 skip_without_dynamic_extension("Devel::Peek");
@@ -77,3 +77,35 @@ sub {
   is ord substr($_[0], 1, 1), 0x100,
     'get-magic resets uf8cache on defelems';
 }->($h{k});
+
+
+# Overloading can also reallocate the PV.
+
+package UTF8Toggle {
+    use overload '""' => 'stringify', fallback => 1;
+
+    sub new {
+	my $class = shift;
+	my $value = shift;
+	my $state = shift||0;
+	return bless [$value, $state], $class;
+    }
+
+    sub stringify {
+	my $self = shift;
+	$self->[1] = ! $self->[1];
+	if ($self->[1]) {
+	    utf8::downgrade($self->[0]);
+	} else {
+	    utf8::upgrade($self->[0]);
+	}
+	$self->[0];
+    }
+}
+my $u = UTF8Toggle->new(" \x{c2}7 ");
+
+pos $u = 2;
+is pos $u, 2, 'pos on overloaded utf8 toggler';
+() = "$u"; # flip flag
+pos $u = 2;
+is pos $u, 2, 'pos on overloaded utf8 toggler (again)'
-- 
2.7.4