[perl #114410] Reset utf8 pos cache on get

If a scalar is gmagical, then the string buffer could change without
the utf8 pos cache being updated.

So it should respond to get-magic, not just set-magic.  Actually add-
ing get-magic to the utf8 magic vtable would cause all scalars with
this magic to be flagged gmagical.  Instead, in magic_get, we can call
magic_setutf8.

diff --git a/mg.c b/mg.c
index 3972a87..089f9c6 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -213,6 +213,10 @@ Perl_mg_get(pTHX_ SV *sv)
            if (mg->mg_flags & MGf_GSKIP)
                (SSPTR(mgs_ix, MGS *))->mgs_magical = 0;
        }
+       else if (vtbl == &PL_vtbl_utf8) {
+           /* get-magic can reallocate the PV */
+           magic_setutf8(sv, mg);
+       }
 
        mg = nextmg;
 

diff --git a/t/op/utf8cache.t b/t/op/utf8cache.t
index f8698c8..a9e88a6 100644 (file)
--- a/t/op/utf8cache.t
+++ b/t/op/utf8cache.t
@@ -9,7 +9,7 @@ BEGIN {
 
 use strict;
 
-plan(tests => 2);
+plan(tests => 5);
 
 SKIP: {
 skip_without_dynamic_extension("Devel::Peek");
@@ -51,3 +51,29 @@ unlike($_, qr{ $utf8magic $utf8magic }x);
     }
     pass("quadratic pos");
 }
+
+# Get-magic can reallocate the PV.  Check that the cache is reset in
+# such cases.
+
+# Regexp vars
+"\x{100}" =~ /(.+)/;
+() = substr $1, 0, 1;
+"a\x{100}" =~ /(.+)/;
+is ord substr($1, 1, 1), 0x100, 'get-magic resets utf8cache on match vars';
+
+# Substr lvalues
+my $x = "a\x{100}";
+my $l = \substr $x, 0;
+() = substr $$l, 1, 1;
+substr $x, 0, 1, = "\x{100}";
+is ord substr($$l, 1, 1), 0x100, 'get-magic resets utf8cache on LVALUEs';
+
+# defelem magic
+my %h;
+sub {
+  $_[0] = "a\x{100}";
+  () = ord substr $_[0], 1, 1;
+  $h{k} = "\x{100}"x2;
+  is ord substr($_[0], 1, 1), 0x100,
+    'get-magic resets uf8cache on defelems';
+}->($h{k});