This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Unbreak gv_fetchmeth_sv
authorFather Chrysostomos <sprout@cpan.org>
Sun, 17 Sep 2017 18:10:11 +0000 (11:10 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 8 Oct 2017 19:06:05 +0000 (12:06 -0700)
Commit v5.21.6-383-gc290e18 stopped gv_fetchmeth_sv from working cor-
rectly when fetching a constant with a utf8 name, because it no longer
passed the utf8 flag to the underlying functions.

That utf8 flag gets passed to gv_init when upgrading a glob proxy
(such as a constant) into a real glob.

ext/XS-APItest/t/gv_fetchmeth.t
gv.c

index 9f6e884..22e8b14 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 40;
+use Test::More tests => 43;
 
 use_ok('XS::APItest');
 
@@ -45,6 +45,10 @@ ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 3, $level, 0), "g
 
     sub method { 1 }
 
+    use constant { φου1 => 1,
+                   φου2 => 2,
+                   φου3 => 3, };
+
     my $meth_as_octets =
             "\357\275\215\357\275\205\357\275\224\357\275\210\357\275\217\357\275\204";
 
@@ -53,6 +57,7 @@ ok !XS::APItest::gv_fetchmeth_type(\%::, "method\0not quite!", 3, $level, 0), "g
         ::is XS::APItest::gv_fetchmeth_type(\%main::, "method", $type, $level, 0), "*main::method", "$types[$type] is UTF-8 clean";
         ::ok !XS::APItest::gv_fetchmeth_type(\%main::, $meth_as_octets, $type, $level, 0);
         ::ok !XS::APItest::gv_fetchmeth_type(\%main::, "method", $type, $level, 0);
+        ::is XS::APItest::gv_fetchmeth_type(\%main::, "φου$type", $type, $level, 0), "*main::φου$type", "$types[$type] can fetch UTF-8 constant";
         
         {
             no strict 'refs';
diff --git a/gv.c b/gv.c
index 6df78cc..eebf542 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -639,7 +639,8 @@ Perl_gv_fetchmeth_sv(pTHX_ HV *stash, SV *namesv, I32 level, U32 flags)
     STRLEN namelen;
     PERL_ARGS_ASSERT_GV_FETCHMETH_SV;
     if (LIKELY(SvPOK_nog(namesv))) /* common case */
-        return gv_fetchmeth_internal(stash, namesv, NULL, 0, level, flags);
+        return gv_fetchmeth_internal(stash, namesv, NULL, 0, level,
+                                     flags | SvUTF8(namesv));
     namepv = SvPV(namesv, namelen);
     if (SvUTF8(namesv)) flags |= SVf_UTF8;
     return gv_fetchmeth_pvn(stash, namepv, namelen, level, flags);