Only cache utf8 offsets for PVs

References and typeglobs can change their stringification without the
SV itself being assigned to.

diff --git a/sv.c b/sv.c
index 906c30e..493ab7b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6642,7 +6642,7 @@ S_sv_pos_u2b_cached(pTHX_ SV *const sv, MAGIC **const mgp, const U8 *const start
     if (!uoffset)
        return 0;
 
-    if (!SvREADONLY(sv) && !SvGMAGICAL(sv)
+    if (!SvREADONLY(sv) && !SvGMAGICAL(sv) && SvPOK(sv)
        && PL_utf8cache
        && (*mgp || (SvTYPE(sv) >= SVt_PVMG &&
                     (*mgp = mg_find(sv, PERL_MAGIC_utf8))))) {
@@ -6725,7 +6725,7 @@ S_sv_pos_u2b_cached(pTHX_ SV *const sv, MAGIC **const mgp, const U8 *const start
        boffset = real_boffset;
     }
 
-    if (PL_utf8cache && !SvGMAGICAL(sv)) {
+    if (PL_utf8cache && !SvGMAGICAL(sv) && SvPOK(sv)) {
        if (at_end)
            utf8_mg_len_cache_update(sv, mgp, uoffset);
        else
@@ -6837,7 +6837,7 @@ S_utf8_mg_len_cache_update(pTHX_ SV *const sv, MAGIC **const mgp,
                           const STRLEN ulen)
 {
     PERL_ARGS_ASSERT_UTF8_MG_LEN_CACHE_UPDATE;
-    if (SvREADONLY(sv))
+    if (SvREADONLY(sv) || !SvPOK(sv))
        return;
 
     if (!*mgp && (SvTYPE(sv) < SVt_PVMG ||

diff --git a/t/op/utf8cache.t b/t/op/utf8cache.t
index 556cceb..9e78e72 100644 (file)
--- a/t/op/utf8cache.t
+++ b/t/op/utf8cache.t
@@ -9,7 +9,7 @@ BEGIN {
 
 use strict;
 
-plan(tests => 9);
+plan(tests => 13);
 
 SKIP: {
 skip_without_dynamic_extension("Devel::Peek");
@@ -117,3 +117,35 @@ is ord ${\substr($u, 1)}, 0xc2,
 () = ord substr $u, 1;
 is ord substr($u, 1), 0xc2,
     'utf8 cache + overloading does not confuse substr lvalues (again)';
+
+
+# Typeglobs and references should not get a cache
+use utf8;
+
+#substr
+my $globref = \*αabcdefg_::_;
+() = substr($$globref, 2, 3);
+*_abcdefgα:: = \%αabcdefg_::;
+undef %αabcdefg_::;
+{ no strict; () = *{"_abcdefgα::_"} }
+is substr($$globref, 2, 3), "abc", 'no utf8 pos cache on globs';
+
+my $ref = bless [], "αabcd_";
+() = substr($ref, 1, 3);
+bless $ref, "_abcdα";
+is substr($ref, 1, 3), "abc", 'no utf8 pos cache on references';
+
+#length
+$globref = \*αabcdefg_::_;
+() = "$$globref";  # turn utf8 flag on
+() = length($$globref);
+*_abcdefgα:: = \%αabcdefg_::;
+undef %αabcdefg_::;
+{ no strict; () = *{"_abcdefgα::_"} }
+is length($$globref), length("$$globref"), 'no utf8 length cache on globs';
+
+$ref = bless [], "αabcd_";
+() = "$ref"; # turn utf8 flag on
+() = length $ref;
+bless $ref, "α";
+is length $ref, length "$ref", 'no utf8 length cache on references';