Make substr assignment work with changing UTF8ness

[perl5.git] / t / op / utf8cache.t

diff --git a/t/op/utf8cache.t b/t/op/utf8cache.t
index 2d10332..65254b1 100644 (file)
--- a/t/op/utf8cache.t
+++ b/t/op/utf8cache.t
@@ -9,7 +9,7 @@ BEGIN {
 
 use strict;
 
-plan(tests => 7);
+plan(tests => 15);
 
 SKIP: {
 skip_without_dynamic_extension("Devel::Peek");
@@ -108,4 +108,56 @@ 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)'
+is pos $u, 2, 'pos on overloaded utf8 toggler (again)';
+
+() = ord ${\substr $u, 1};
+is ord ${\substr($u, 1)}, 0xc2,
+    'utf8 cache + overloading does not confuse substr lvalues';
+() = "$u"; # flip flag
+() = ord substr $u, 1;
+is ord substr($u, 1), 0xc2,
+    'utf8 cache + overloading does not confuse substr lvalues (again)';
+
+$u = UTF8Toggle->new(" \x{c2}7 ");
+() = ord ${\substr $u, 2};
+{ no warnings; ${\substr($u, 2, 1)} = 0; }
+is $u, " \x{c2}0 ",
+    'utf8 cache + overloading does not confuse substr lvalue assignment';
+$u = UTF8Toggle->new(" \x{c2}7 ");
+() = "$u"; # flip flag
+() = ord ${\substr $u, 2};
+{ no warnings; ${\substr($u, 2, 1)} = 0; }
+is $u, " \x{c2}0 ",
+    'utf8 cache + overload does not confuse substr lv assignment (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';