This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
gv.c: Initial gv_fetchpvn_flags and gv_stashpvn UTF8 cleanup
authorBrian Fraser <fraserbn@gmail.com>
Sat, 24 Sep 2011 18:57:27 +0000 (11:57 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 6 Oct 2011 20:01:02 +0000 (13:01 -0700)
Now that a glob can be initialized and fetched in UTF-8,
the next commit will introduce some changes in toke.c to
actually test this.

Committer’s note: To keep tests passing I had to incorporate
the toke.c:S_pending_ident changes in the same patch.

ext/XS-APItest/t/fetch_pad_names.t
gv.c
toke.c

index 8d6e739..559bc3f 100644 (file)
@@ -165,7 +165,6 @@ END_EVAL
 
 }
 
-#XXX: This will most certainly break once clean stashes are out.
 $cv = sub {
     use utf8;
     our $戦国 = 10;
@@ -185,7 +184,8 @@ $names_av = fetch_pad_names($cv);
 general_tests( $cv->(), $names_av, {
     results => [
                 { cmp => '10', msg => 'Fetched UTF-8 our var.' },
-                ({ cmp => '10', msg => "Symref fetch." }) x 2,
+                { cmp => '10', msg => "Symref fetch of an our works." },
+                { cmp => undef, msg => "..and using the encoded form yields undef." },
                ],
     pad_size => {
                     total     => { cmp => 3, msg => 'Sub has three lexicals.' },
diff --git a/gv.c b/gv.c
index d2a0ed0..f5dedee 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1285,7 +1285,7 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
     if (!(flags & ~GV_NOADD_MASK) && !stash) return NULL;
     assert(stash);
     if (!HvNAME_get(stash)) {
-       hv_name_set(stash, name, namelen, 0);
+       hv_name_set(stash, name, namelen, flags & SVf_UTF8 ? SVf_UTF8 : 0 );
        
        /* FIXME: This is a repeat of logic in gv_fetchpvn_flags */
        /* If the containing stash has multiple effective
@@ -1312,7 +1312,7 @@ Perl_gv_stashsv(pTHX_ SV *sv, I32 flags)
 
     PERL_ARGS_ASSERT_GV_STASHSV;
 
-    return gv_stashpvn(ptr, len, flags);
+    return gv_stashpvn(ptr, len, flags | SvUTF8(sv));
 }
 
 
@@ -1414,7 +1414,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    tmpbuf[len++] = ':';
                    key = tmpbuf;
                }
-               gvp = (GV**)hv_fetch(stash, key, len, add);
+               gvp = (GV**)hv_fetch(stash, key, is_utf8 ? -len : len, add);
                gv = gvp ? *gvp : NULL;
                if (gv && gv != (const GV *)&PL_sv_undef) {
                    if (SvTYPE(gv) != SVt_PVGV)
@@ -1436,7 +1436,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                            hv_name_set(stash, "CORE", 4, 0);
                        else
                            hv_name_set(
-                               stash, nambeg, name_cursor-nambeg, 0
+                               stash, nambeg, name_cursor-nambeg, is_utf8
                            );
                        /* If the containing stash has multiple effective
                           names, see that this one gets them, too. */
@@ -1445,7 +1445,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    }
                }
                else if (!HvNAME_get(stash))
-                   hv_name_set(stash, nambeg, name_cursor - nambeg, 0);
+                   hv_name_set(stash, nambeg, name_cursor - nambeg, is_utf8);
            }
 
            if (*name_cursor == ':')
@@ -1512,7 +1512,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    !(len == 1 && sv_type == SVt_PV &&
                      (*name == 'a' || *name == 'b')) )
                {
-                   gvp = (GV**)hv_fetch(stash,name,len,0);
+                   gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -len : len,0);
                    if (!gvp ||
                        *gvp == (const GV *)&PL_sv_undef ||
                        SvTYPE(*gvp) != SVt_PVGV)
@@ -1574,7 +1574,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     if (!SvREFCNT(stash))      /* symbol table under destruction */
        return NULL;
 
-    gvp = (GV**)hv_fetch(stash,name,len,add);
+    gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -len : len,add);
     if (!gvp || *gvp == (const GV *)&PL_sv_undef) {
        if (addmg) gv = (GV *)newSV(0);
        else return NULL;
diff --git a/toke.c b/toke.c
index 5261c6c..cdde065 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -8347,7 +8347,7 @@ S_pending_ident(pTHX)
                HEK * const stashname = HvNAME_HEK(stash);
                SV *  const sym = newSVhek(stashname);
                 sv_catpvs(sym, "::");
-                sv_catpvn(sym, PL_tokenbuf+1, tokenbuf_len - 1);
+                sv_catsv(sym, newSVpvn_flags(PL_tokenbuf+1, tokenbuf_len - 1, SVs_TEMP | (UTF ? SVf_UTF8 : 0 )));
                 pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
                 pl_yylval.opval->op_private = OPpCONST_ENTERED;
                 gv_fetchsv(sym,
@@ -8391,8 +8391,8 @@ S_pending_ident(pTHX)
     */
     if (ckWARN(WARN_AMBIGUOUS) &&
        pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
-        GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1, 0,
-                                        SVt_PVAV);
+        GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1,
+                                        ( UTF ? SVf_UTF8 : 0 ), SVt_PVAV);
         if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
                /* DO NOT warn for @- and @+ */
                && !( PL_tokenbuf[2] == '\0' &&
@@ -8407,11 +8407,13 @@ S_pending_ident(pTHX)
     }
 
     /* build ops for a bareword */
-    pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn(PL_tokenbuf + 1,
-                                                     tokenbuf_len - 1));
+    pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn_flags(PL_tokenbuf + 1,
+                                                     tokenbuf_len - 1,
+                                                      UTF ? SVf_UTF8 : 0 ));
     pl_yylval.opval->op_private = OPpCONST_ENTERED;
     gv_fetchpvn_flags(PL_tokenbuf+1, tokenbuf_len - 1,
-                    PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD,
+                    (PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD)
+                     | ( UTF ? SVf_UTF8 : 0 ),
                     ((PL_tokenbuf[0] == '$') ? SVt_PV
                      : (PL_tokenbuf[0] == '@') ? SVt_PVAV
                      : SVt_PVHV));