This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In makemeta, pass the final file name as the second argument to safer_open()
[perl5.git] / utf8.c
diff --git a/utf8.c b/utf8.c
index d496afc..11c2fa4 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -841,7 +841,7 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e)
            Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
                             "%s in %s", unees, OP_DESC(PL_op));
        else
-           Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), unees);
+           Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "%s", unees);
     }
 
     return len;
@@ -953,7 +953,7 @@ Perl_bytes_cmp_utf8(pTHX_ const U8 *b, STRLEN blen, const U8 *u, STRLEN ulen)
                        Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
                                         "%s in %s", unees, OP_DESC(PL_op));
                    else
-                       Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), unees);
+                       Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "%s", unees);
                    return -2; /* Really want to return undef :-)  */
                }
            } else {
@@ -1341,12 +1341,12 @@ Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp)
 }
 
 UV
-Perl_to_uni_fold(pTHX_ UV c, U8* p, STRLEN *lenp)
+Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, U8 flags)
 {
-    PERL_ARGS_ASSERT_TO_UNI_FOLD;
+    PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS;
 
     uvchr_to_utf8(p, c);
-    return to_utf8_fold(p, p, lenp);
+    return _to_utf8_fold_flags(p, p, lenp, flags);
 }
 
 /* for now these all assume no locale info available for Unicode > 255 */
@@ -1799,7 +1799,7 @@ of the result.
 
 The "swashp" is a pointer to the swash to use.
 
-Both the special and normal mappings are stored lib/unicore/To/Foo.pl,
+Both the special and normal mappings are stored in lib/unicore/To/Foo.pl,
 and loaded by SWASHNEW, using lib/utf8_heavy.pl.  The special (usually,
 but not always, a multicharacter mapping), is tried first.
 
@@ -2026,15 +2026,20 @@ The first character of the foldcased version is returned
 
 =cut */
 
+/* Not currently externally documented is 'flags', which currently is non-zero
+ * if full case folds are to be used; otherwise simple folds */
+
 UV
-Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)
 {
+    const char *specials = (flags) ? "utf8::ToSpecFold" : NULL;
+
     dVAR;
 
-    PERL_ARGS_ASSERT_TO_UTF8_FOLD;
+    PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS;
 
     return Perl_to_utf8_case(aTHX_ p, ustrp, lenp,
-                             &PL_utf8_tofold, "ToFold", "utf8::ToSpecFold");
+                             &PL_utf8_tofold, "ToFold", specials);
 }
 
 /* Note:
@@ -3195,6 +3200,8 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, register UV l1, bool u1
            if ((flags & FOLDEQ_UTF8_LOCALE)
                && (! u2 || UTF8_IS_INVARIANT(*p2) || UTF8_IS_DOWNGRADEABLE_START(*p2)))
            {
+               /* Here, the next char in s2 is < 256.  We've already worked on
+                * s1, and if it isn't also < 256, can't match */
                if (u1 && (! UTF8_IS_INVARIANT(*p1)
                    && ! UTF8_IS_DOWNGRADEABLE_START(*p1)))
                {
@@ -3206,7 +3213,13 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, register UV l1, bool u1
                else {
                    *foldbuf2 = TWO_BYTE_UTF8_TO_UNI(*p2, *(p2 + 1));
                }
-               n2 = 1;
+
+               /* Use another function to handle locale rules.  We've made
+                * sure that both characters to compare are single bytes */
+               if (! foldEQ_locale((char *) f1, (char *) foldbuf2, 1)) {
+                   return 0;
+               }
+               n1 = n2 = 0;
            }
            else if (isASCII(*p2)) {
                if (flags && ! isASCII(*p1)) {
@@ -3225,19 +3238,9 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, register UV l1, bool u1
             f2 = foldbuf2;
         }
 
-       /* Here f1 and f2 point to the beginning of the strings to compare.  In
-        * the case of Unicode rules, these strings are the folds of the input
-        * characters, stored in utf8.  In the case of locale rules, they are
-        * the original characters, each stored as a single byte. */
-
-       /* Use another function to handle locale rules.  n1 has to equal n2
-        * under them, as they've been converted to single bytes above */
-       if (flags & FOLDEQ_UTF8_LOCALE && n1 == 1) {
-           if (! foldEQ_locale((char *) f1, (char *) f2, 1)) {
-               return 0;
-           }
-           n1 = n2 = 0;
-       }
+       /* Here f1 and f2 point to the beginning of the strings to compare.
+        * These strings are the folds of the input characters, stored in utf8.
+        */
 
         /* While there is more to look for in both folds, see if they
         * continue to match */