mro UTF8 cleanup.

This patch also duplicates existing mro tests with copies that use
Unicode in identifiers, to test the mro code.

Since those tests trigger it, it also fixes a bug in the parsing
of *{...}: If the first character inside the braces is a non-ASCII
Unicode identifier character, the inside is now implicitly quoted
if it is just an identifier (just as it is with ASCII identifiers),
instead of being parsed as a bareword that would violate strict subs.

1 files changed, 64 insertions, 36 deletions

diff --git a/mro.c b/mro.c
index 830bea8097..a869b1814e 100644
--- a/mro.c
+++ b/mro.c
@@ -471,6 +471,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
 
     const char * const stashname = HvENAME_get(stash);
     const STRLEN stashname_len = HvENAMELEN_get(stash);
+    const bool stashname_utf8  = HvENAMEUTF8(stash) ? 1 : 0;
 
     PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN;
 
@@ -493,7 +494,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
     /* Wipe the global method cache if this package
        is UNIVERSAL or one of its parents */
 
-    svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
+    svp = hv_fetch(PL_isarev, stashname,
+                        stashname_utf8 ? -stashname_len : stashname_len, 0);
     isarev = svp ? MUTABLE_HV(*svp) : NULL;
 
     if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
@@ -530,9 +532,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
             isa_hashes = (HV *)sv_2mortal((SV *)newHV());
         }
         while((iter = hv_iternext(isarev))) {
-	    I32 len;
-            const char* const revkey = hv_iterkey(iter, &len);
-            HV* revstash = gv_stashpvn(revkey, len, 0);
+            HV* revstash = gv_stashsv(hv_iterkeysv(iter), 0);
             struct mro_meta* revmeta;
 
             if(!revstash) continue;
@@ -595,7 +595,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
 	   
                     (void)
                       hv_store(
-                       mroisarev, HEK_KEY(namehek), HEK_LEN(namehek),
+                       mroisarev, HEK_KEY(namehek),
+                       HEK_UTF8(namehek) ? -HEK_LEN(namehek) : HEK_LEN(namehek),
                        &PL_sv_yes, 0
                       );
                 }
@@ -603,7 +604,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
                 if((SV *)isa != &PL_sv_undef)
                     mro_clean_isarev(
                      isa, HEK_KEY(namehek), HEK_LEN(namehek),
-                     HvMROMETA(revstash)->isa
+                     HvMROMETA(revstash)->isa, (HEK_UTF8(namehek) ? SVf_UTF8 : 0)
                     );
             }
         }
@@ -637,18 +638,20 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
 	   save time by not making two calls to the common HV code for the
 	   case where it doesn't exist.  */
 	   
-	(void)hv_store(mroisarev, stashname, stashname_len, &PL_sv_yes, 0);
+	(void)hv_store(mroisarev, stashname,
+                stashname_utf8 ? -stashname_len : stashname_len, &PL_sv_yes, 0);
     }
 
     /* Delete our name from our former parents’ isarevs. */
     if(isa && HvARRAY(isa))
-        mro_clean_isarev(isa, stashname, stashname_len, meta->isa);
+        mro_clean_isarev(isa, stashname, stashname_len, meta->isa,
+                                (stashname_utf8 ? SVf_UTF8 : 0) );
 }
 
 /* Deletes name from all the isarev entries listed in isa */
 STATIC void
 S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name,
-                         const STRLEN len, HV * const exceptions)
+                         const STRLEN len, HV * const exceptions, U32 flags)
 {
     HE* iter;
 
@@ -660,13 +663,15 @@ S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name,
         while((iter = hv_iternext(isa))) {
             I32 klen;
             const char * const key = hv_iterkey(iter, &klen);
-            if(exceptions && hv_exists(exceptions, key, klen)) continue;
-            svp = hv_fetch(PL_isarev, key, klen, 0);
+            if(exceptions && hv_exists(exceptions, key, HeKUTF8(iter) ? -klen : klen))
+                continue;
+            svp = hv_fetch(PL_isarev, key, HeKUTF8(iter) ? -klen : klen, 0);
             if(svp) {
                 HV * const isarev = (HV *)*svp;
-                (void)hv_delete(isarev, name, len, G_DISCARD);
+                (void)hv_delete(isarev, name, (flags & SVf_UTF8) ? -len : len, G_DISCARD);
                 if(!HvARRAY(isarev) || !HvUSEDKEYS(isarev))
-                    (void)hv_delete(PL_isarev, key, klen, G_DISCARD);
+                    (void)hv_delete(PL_isarev, key,
+                                        HeKUTF8(iter) ? -klen : klen, G_DISCARD);
             }
         }
     }
@@ -732,7 +737,8 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
 	SV **svp;
 	if(
 	 !GvSTASH(gv) || !HvENAME(GvSTASH(gv)) ||
-	 !(svp = hv_fetch(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), 0)) ||
+	 !(svp = hv_fetch(GvSTASH(gv), GvNAME(gv),
+                            GvNAMEUTF8(gv) ? -GvNAMELEN(gv) : GvNAMELEN(gv), 0)) ||
 	 *svp != (SV *)gv
 	) return;
     }
@@ -760,9 +766,12 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
 	    if (GvNAMELEN(gv) == 1) sv_catpvs(namesv, ":");
 	    else                    sv_catpvs(namesv, "::");
 	}
-	if (GvNAMELEN(gv) != 1)
+	if (GvNAMELEN(gv) != 1) {
 	    sv_catpvn(namesv, GvNAME(gv), GvNAMELEN(gv) - 2);
 	                                  /* skip trailing :: */
+            if ( GvNAMEUTF8(gv) )
+                SvUTF8_on(namesv);
+        }
     }
     else {
 	SV *aname;
@@ -779,9 +788,12 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
 		if (GvNAMELEN(gv) == 1) sv_catpvs(aname, ":");
 		else                    sv_catpvs(aname, "::");
 	    }
-	    if (GvNAMELEN(gv) != 1)
+	    if (GvNAMELEN(gv) != 1) {
 		sv_catpvn(aname, GvNAME(gv), GvNAMELEN(gv) - 2);
 	                                  /* skip trailing :: */
+                if ( GvNAMEUTF8(gv) )
+                    SvUTF8_on(aname);
+            }
 	    av_push((AV *)namesv, aname);
 	}
     }
@@ -902,11 +914,12 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 		svp = &namesv;
 	    }
 	    while (items--) {
+                const U32 name_utf8 = SvUTF8(*svp);
 		STRLEN len;
 		const char *name = SvPVx_const(*svp++, len);
 		if(PL_stashcache)
-		    (void)hv_delete(PL_stashcache, name, len, G_DISCARD);
-	        hv_ename_delete(oldstash, name, len, 0);
+		   (void)hv_delete(PL_stashcache, name, name_utf8 ? -len : len, G_DISCARD);
+	        hv_ename_delete(oldstash, name, len, name_utf8);
 
 		if (!fetched_isarev) {
 		    /* If the name deletion caused a name change, then we
@@ -919,8 +932,9 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 		     * fies it for us, so sv_2mortal is not necessary. */
 		    if(HvENAME_HEK(oldstash) != enamehek) {
 			if(meta->isa && HvARRAY(meta->isa))
-			    mro_clean_isarev(meta->isa, name, len, NULL);
-			isarev = (HV *)hv_delete(PL_isarev, name, len, 0);
+			    mro_clean_isarev(meta->isa, name, len, 0, name_utf8);
+			isarev = (HV *)hv_delete(PL_isarev, name,
+                                                    name_utf8 ? -len : len, 0);
 			fetched_isarev=TRUE;
 		    }
 		}
@@ -938,9 +952,10 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 	    svp = &namesv;
 	}
 	while (items--) {
+            const U32 name_utf8 = SvUTF8(*svp);
 	    STRLEN len;
 	    const char *name = SvPVx_const(*svp++, len);
-	    hv_ename_add(stash, name, len, 0);
+	    hv_ename_add(stash, name, len, name_utf8);
 	}
 
        /* Add it to the big list if it needs
@@ -1005,7 +1020,10 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 	    /* Extra variable to avoid a compiler warning */
 	    char * const hvename = HvENAME(oldstash);
 	    fetched_isarev = TRUE;
-	    svp = hv_fetch(PL_isarev, hvename, HvENAMELEN_get(oldstash), 0);
+	    svp = hv_fetch(PL_isarev, hvename,
+                            HvENAMEUTF8(oldstash)
+                                ? -HvENAMELEN_get(oldstash)
+                                : HvENAMELEN_get(oldstash), 0);
 	    if (svp) isarev = MUTABLE_HV(*svp);
 	}
 	else if(SvTYPE(namesv) == SVt_PVAV) {
@@ -1030,9 +1048,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 
 	hv_iterinit(isarev);
 	while((iter = hv_iternext(isarev))) {
-	    I32 len;
-	    const char* const revkey = hv_iterkey(iter, &len);
-	    HV* revstash = gv_stashpvn(revkey, len, 0);
+	    HV* revstash = gv_stashsv(hv_iterkeysv(iter), 0);
 	    struct mro_meta * meta;
 
 	    if(!revstash) continue;
@@ -1069,19 +1085,21 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 
 	    /* Iterate through the entries in this list */
 	    for(; entry; entry = HeNEXT(entry)) {
+		SV* keysv;
 		const char* key;
-		I32 len;
+		STRLEN len;
 
 		/* If this entry is not a glob, ignore it.
 		   Try the next.  */
 		if (!isGV(HeVAL(entry))) continue;
 
-		key = hv_iterkey(entry, &len);
+                keysv = hv_iterkeysv(entry);
+		key = SvPV_const(keysv, len);
 		if ((len > 1 && key[len-2] == ':' && key[len-1] == ':')
 		 || (len == 1 && key[0] == ':')) {
 		    HV * const oldsubstash = GvHV(HeVAL(entry));
 		    SV ** const stashentry
-		     = stash ? hv_fetch(stash, key, len, 0) : NULL;
+		     = stash ? hv_fetch(stash, key, SvUTF8(keysv) ? -len : len, 0) : NULL;
 		    HV *substash = NULL;
 
 		    /* Avoid main::main::main::... */
@@ -1110,6 +1128,8 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 				else {
 				    sv_catpvs(aname, "::");
 				    sv_catpvn(aname, key, len-2);
+                                    if ( SvUTF8(keysv) )
+                                        SvUTF8_on(aname);
 				}
 				av_push((AV *)subname, aname);
 			    }
@@ -1120,6 +1140,8 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 			    else {
 				sv_catpvs(subname, "::");
 				sv_catpvn(subname, key, len-2);
+                                if ( SvUTF8(keysv) )
+                                    SvUTF8_on(subname);
 			    }
 			}
 			mro_gather_and_rename(
@@ -1128,7 +1150,7 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 			);
 		    }
 
-		    (void)hv_store(seen, key, len, &PL_sv_yes, 0);
+		    (void)hv_store(seen, key, SvUTF8(keysv) ? -len : len, &PL_sv_yes, 0);
 		}
 	    }
 	}
@@ -1146,21 +1168,23 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 
 	    /* Iterate through the entries in this list */
 	    for(; entry; entry = HeNEXT(entry)) {
+		SV* keysv;
 		const char* key;
-		I32 len;
+		STRLEN len;
 
 		/* If this entry is not a glob, ignore it.
 		   Try the next.  */
 		if (!isGV(HeVAL(entry))) continue;
 
-		key = hv_iterkey(entry, &len);
+                keysv = hv_iterkeysv(entry);
+		key = SvPV_const(keysv, len);
 		if ((len > 1 && key[len-2] == ':' && key[len-1] == ':')
 		 || (len == 1 && key[0] == ':')) {
 		    HV *substash;
 
 		    /* If this entry was seen when we iterated through the
 		       oldstash, skip it. */
-		    if(seen && hv_exists(seen, key, len)) continue;
+		    if(seen && hv_exists(seen, key, SvUTF8(keysv) ? -len : len)) continue;
 
 		    /* We get here only if this stash has no corresponding
 		       entry in the stash being replaced. */
@@ -1186,6 +1210,8 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 				else {
 				    sv_catpvs(aname, "::");
 				    sv_catpvn(aname, key, len-2);
+                                    if ( SvUTF8(keysv) )
+                                        SvUTF8_on(aname);
 				}
 				av_push((AV *)subname, aname);
 			    }
@@ -1196,6 +1222,8 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes,
 			    else {
 				sv_catpvs(subname, "::");
 				sv_catpvn(subname, key, len-2);
+                                if ( SvUTF8(keysv) )
+                                    SvUTF8_on(subname);
 			    }
 			}
 			mro_gather_and_rename(
@@ -1244,8 +1272,10 @@ Perl_mro_method_changed_in(pTHX_ HV *stash)
 {
     const char * const stashname = HvENAME_get(stash);
     const STRLEN stashname_len = HvENAMELEN_get(stash);
+    const bool stashname_utf8 = HvENAMEUTF8(stash) ? 1 : 0;
 
-    SV ** const svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
+    SV ** const svp = hv_fetch(PL_isarev, stashname,
+                                    stashname_utf8 ? -stashname_len : stashname_len, 0);
     HV * const isarev = svp ? MUTABLE_HV(*svp) : NULL;
 
     PERL_ARGS_ASSERT_MRO_METHOD_CHANGED_IN;
@@ -1271,9 +1301,7 @@ Perl_mro_method_changed_in(pTHX_ HV *stash)
 
         hv_iterinit(isarev);
         while((iter = hv_iternext(isarev))) {
-	    I32 len;
-            const char* const revkey = hv_iterkey(iter, &len);
-            HV* const revstash = gv_stashpvn(revkey, len, 0);
+            HV* const revstash = gv_stashsv(hv_iterkeysv(iter), 0);
             struct mro_meta* mrometa;
 
             if(!revstash) continue;