From @tonycoz

0001-perl-131263-clear-the-UTF8-flag-on-a-glob-if-it-isn-.patch

From fc661be6f8ba0ef072eb3874d6d7cfbe11329781 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 5 Jun 2017 14:38:14 +1000
Subject: [PATCH] [perl #131263] clear the UTF8 flag on a glob if it isn't UTF8

Previously sv_2pv_flags() would set the UTF8 flag on a glob if it
had a UTF8 name, but wouldn't clear it if it didn't.

This meant a name change (eg. if assigned another glob) from a UTF8
name to a non-UTF8 name would leave the flag set.
---
 sv.c      |  2 ++
 t/op/gv.t | 10 +++++++++-
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/sv.c b/sv.c
index db51175..3296519 100644
--- a/sv.c
+++ b/sv.c
@@ -3181,6 +3181,8 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
 	assert(SvPOK(buffer));
 	if (SvUTF8(buffer))
 	    SvUTF8_on(sv);
+        else
+            SvUTF8_off(sv);
 	if (lp)
 	    *lp = SvCUR(buffer);
 	return SvPVX(buffer);
diff --git a/t/op/gv.t b/t/op/gv.t
index be6b0dd..4c2c43f 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan(tests => 280);
+plan(tests => 282);
 
 # type coercion on assignment
 $foo = 'foo';
@@ -1170,6 +1170,14 @@ SKIP: {
     is ($? & 127, 0,"[perl #128597] No crash when gp_free calls ckWARN_d");
 }
 
+{
+    # [perl #131263]
+    *sym = "\N{U+0080}";
+    ok(*sym eq "*main::\N{U+0080}", "utf8 flag properly set");
+    *sym = "\xC3\x80";
+    ok(*sym eq "*main::\xC3\x80", "utf8 flag properly cleared");
+}
+
 # test gv_try_downgrade()
 # If a GV can be stored in a stash in a compact, non-GV form, then
 # whenever ops are freed which reference the GV, an attempt is made to
-- 
2.1.4

Perl mess with UTF8 flag of GV #15971

Description

Metadata

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Issue actions