This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
gv.c: gv_fetchmethod_(flags|autoload) UTF8 cleanup.
authorBrian Fraser <fraserbn@gmail.com>
Tue, 4 Oct 2011 01:16:03 +0000 (18:16 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 6 Oct 2011 20:01:07 +0000 (13:01 -0700)
ext/XS-APItest/t/gv_fetchmethod_flags.t
gv.c

index 068cfec..15d1c41 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 9; #23;
+use Test::More tests => 24;
 
 use_ok('XS::APItest');
 
@@ -21,7 +21,6 @@ ok !XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 3, 0), "g
 ok XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 0, 0), "gv_fetchmethod_flags() is not nul-clean";
 is XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 2, 0), "*main::method", "gv_fetchmethod_flags_pv() is not nul-clean";
 
-=begin
 {
     use utf8;
     use open qw( :utf8 :std );
@@ -31,8 +30,12 @@ is XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 2, 0), "*m
     sub method { 1 }
     sub method { 1 }
 
+    my $meth_as_octets =
+            "\357\275\215\357\275\205\357\275\224\357\275\210\357\275\217\357\275\204";
+
     for my $type ( 1..3 ) {
         ::is XS::APItest::gv_fetchmethod_flags_type(\%main::, "method", $type, 0), "*main::method";
+        ::ok !XS::APItest::gv_fetchmethod_flags_type(\%main::, $meth_as_octets, $type, 0);
         ::is XS::APItest::gv_fetchmethod_flags_type(\%main::, "method", $type, 0), "*main::method";
         
         {
@@ -44,9 +47,5 @@ is XS::APItest::gv_fetchmethod_flags_type(\%::, "method\0not quite!", 2, 0), "*m
                             \%{"\357\275\215\357\275\201\357\275\211\357\275\216::"},
                             "method", $type, 0);
         }
-        ::ok !XS::APItest::gv_fetchmethod_flags_type(\%main::,
-                  "\357\275\215\357\275\205\357\275\224\357\275\210\357\275\217\357\275\204",
-                   $type, 0);
     }
 }
-=cut
diff --git a/gv.c b/gv.c
index f77d96c..30ffa0a 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -973,6 +973,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
     SV *const error_report = MUTABLE_SV(stash);
     const U32 autoload = flags & GV_AUTOLOAD;
     const U32 do_croak = flags & GV_CROAK;
+    const U32 is_utf8  = flags & SVf_UTF8;
 
     PERL_ARGS_ASSERT_GV_FETCHMETHOD_PVN_FLAGS;
 
@@ -997,8 +998,8 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
     if (nsplit) {
        if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
            /* ->SUPER::method should really be looked up in original stash */
-           SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
-                                                 CopSTASHPV(PL_curcop)));
+           SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"::SUPER",
+                     SVfARG(sv_2mortal(newSVhek(HvNAME_HEK((HV*)CopSTASH(PL_curcop)))))));
            /* __PACKAGE__::SUPER stash should be autovivified */
            stash = gv_get_super_pkg(SvPVX_const(tmpstr), SvCUR(tmpstr), SvUTF8(tmpstr));
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
@@ -1006,19 +1007,19 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
        }
        else {
             /* don't autovifify if ->NoSuchStash::method */
-            stash = gv_stashpvn(origname, nsplit - origname, 0);
+            stash = gv_stashpvn(origname, nsplit - origname, is_utf8);
 
            /* however, explicit calls to Pkg::SUPER::method may
               happen, and may require autovivification to work */
            if (!stash && (nsplit - origname) >= 7 &&
                strnEQ(nsplit - 7, "::SUPER", 7) &&
-               gv_stashpvn(origname, nsplit - origname - 7, 0))
+               gv_stashpvn(origname, nsplit - origname - 7, is_utf8))
              stash = gv_get_super_pkg(origname, nsplit - origname, flags);
        }
        ostash = stash;
     }
 
-    gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, 0);
+    gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
     if (!gv) {
        if (strEQ(name,"import") || strEQ(name,"unimport"))
            gv = MUTABLE_GV(&PL_sv_yes);
@@ -1040,7 +1041,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
                                       HV_FETCH_ISEXISTS, NULL, 0)
                ) {
                    require_pv("IO/File.pm");
-                   gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, 0);
+                   gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
                    if (gv)
                        return gv;
                }