This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
util.c for threads: stashpv_hvname_match UTF8 cleanup.
authorBrian Fraser <fraserbn@gmail.com>
Sat, 23 Jul 2011 21:48:51 +0000 (18:48 -0300)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 6 Oct 2011 20:01:11 +0000 (13:01 -0700)
util.c

diff --git a/util.c b/util.c
index 82d7590..113cd17 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5827,16 +5827,25 @@ Perl_get_hash_seed(pTHX)
 bool
 Perl_stashpv_hvname_match(pTHX_ const COP *c, const HV *hv)
 {
-    const char * const stashpv = CopSTASHPV(c);
-    const char * const name = HvNAME_get(hv);
+    const char * stashpv = CopSTASHPV(c);
+    const char * name    = HvNAME_get(hv);
     PERL_UNUSED_CONTEXT;
     PERL_ARGS_ASSERT_STASHPV_HVNAME_MATCH;
 
-    if (stashpv == name)
-       return TRUE;
-    if (stashpv && name)
-       if (strEQ(stashpv, name))
-           return TRUE;
+    if ( HvNAMEUTF8(hv) && !(CopSTASH_flags(c) & SVf_UTF8 ? 1 : 0) ) {
+        if (CopSTASH_flags(c) & SVf_UTF8) {
+            return (bytes_cmp_utf8(
+                        (const U8*)stashpv, strlen(stashpv),
+                        (const U8*)name, HEK_LEN(HvNAME_HEK(hv))) == 0);
+        } else {
+            return (bytes_cmp_utf8(
+                        (const U8*)name, HEK_LEN(HvNAME_HEK(hv)),
+                        (const U8*)stashpv, strlen(stashpv)) == 0);
+        }
+    }
+    else
+        return (stashpv == name
+                    || strEQ(stashpv, name));
     return FALSE;
 }
 #endif