Commit 548fbca1a3 for perl
commit 548fbca1a3f3ea8f7f55ec876cd47b2d9c6db3c1
Author: Karl Williamson <khw@cpan.org>
Date: Thu Sep 17 09:18:24 2026 -0600
Prepare source for Unicode 18.0
Unicode 18.0 introduces a second character whose fold is to U+00DF,
LATIN SMALL SHARP S !!!
This character requires significant special handling because it folds to
the two character string "ss". This is likely the most problematic
character in all Unicode (not including security issues). To properly
handle it would require a complete redesign of the regex engine. This
is not limited to Perl. Others have pressured Unicode to change the
Standard, to no avail.
So Unicode 18 has introduced a new character that folds to this. Its
formal name is uncomfortably long, but it has a shorter informal name:
SURSOLIDUM, which I am mostly using.
The character is apparently not in modern use, but was in some
mathematical texts in the 1600s.
Anyway, Perl is accommodating the new Standard, and these relatively few
changes accomplish that.
diff --git a/embed.h b/embed.h
index 18bf92f5c9..762baf13cb 100644
--- a/embed.h
+++ b/embed.h
@@ -82,9 +82,12 @@
# undef first_upper_bit_set_byte_number
# undef invlist_intersection_complement_2nd_
# undef invlist_union_complement_2nd_
+# undef LATIN_SMALL_LIGATURE_LONG_S_WITH_DESCENDER_S
+# undef LATIN_SMALL_LIGATURE_LONG_S_WITH_DESCENDER_S_UTF8
# undef PARSE_IDENT_ERROR_POSITION
# undef PARSE_IDENT_ERROR_TEXT
# undef RExC_parse_advance
+# undef SURSOLIDUM
# undef WARN_HELPER_
# endif /* !defined(PERL_EXT_RE_BUILD) */
# endif /* !defined(PERL_CORE) */
diff --git a/regcomp.c b/regcomp.c
index 5a6d563161..396d2eec47 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7026,13 +7026,16 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
* things */
maybe_exactfu = false;
- /* Although these two characters have folds that are
+ /* Although these characters have folds that are
* locale-problematic, they also have folds to above Latin1
* that aren't a problem. Doing these now helps at
* runtime. */
if ( UNLIKELY(ender == GREEK_CAPITAL_LETTER_MU)
#ifdef LATIN_CAPITAL_LETTER_SHARP_S
|| UNLIKELY(ender == LATIN_CAPITAL_LETTER_SHARP_S)
+#endif
+#ifdef SURSOLIDUM
+ || UNLIKELY(ender == SURSOLIDUM)
#endif
) {
goto fold_anyway;
diff --git a/regen/embed.pl b/regen/embed.pl
index 1cb12ab6b1..45a7e5bb41 100755
--- a/regen/embed.pl
+++ b/regen/embed.pl
@@ -3031,6 +3031,9 @@ my %needed_by_ext_re = map { $_ => 1 } qw(
PARSE_IDENT_ERROR_POSITION
PARSE_IDENT_ERROR_TEXT
RExC_parse_advance
+ LATIN_SMALL_LIGATURE_LONG_S_WITH_DESCENDER_S
+ LATIN_SMALL_LIGATURE_LONG_S_WITH_DESCENDER_S_UTF8
+ SURSOLIDUM
WARN_HELPER_
);
diff --git a/regexec.c b/regexec.c
index 6767201f21..f8953af6ea 100644
--- a/regexec.c
+++ b/regexec.c
@@ -5020,7 +5020,19 @@ S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node,
&& memBEGINs(pat, pat_len, LATIN_SMALL_LETTER_LONG_S_UTF8
LATIN_SMALL_LETTER_LONG_S_UTF8))
{
+
+ /* Anything that folds to U+00DF is very specially handled.
+ * Anything beyond the first such character (U+1E9E) has to be
+ * manually added here */
+ static const U32 remaining_folds_to_17F_17F[] = {
+
+#ifdef SURSOLIDUM
+ SURSOLIDUM
+#endif
+ };
first_fold_from = LATIN_CAPITAL_LETTER_SHARP_S;
+ remaining_fold_froms = remaining_folds_to_17F_17F;
+ folds_to_count = 1 + C_ARRAY_LENGTH(remaining_folds_to_17F_17F);
}
else if (UNLIKELY( op == TURKISH
&& ( isALPHA_FOLD_EQ(folded, 'i')
diff --git a/utf8.c b/utf8.c
index f29eae8d8f..9b9aeaa901 100644
--- a/utf8.c
+++ b/utf8.c
@@ -4532,12 +4532,14 @@ Perl_to_utf8_fold_flags_(pTHX_ const U8 *p,
if (flags & FOLD_FLAGS_LOCALE) {
-# define LONG_S_T LATIN_SMALL_LIGATURE_LONG_S_T_UTF8
+# define LONG_S_T LATIN_SMALL_LIGATURE_LONG_S_T_UTF8
# ifdef LATIN_CAPITAL_LETTER_SHARP_S_UTF8
# define CAP_SHARP_S LATIN_CAPITAL_LETTER_SHARP_S_UTF8
+# endif
+#ifdef CAP_SHARP_S
- /* Special case these two characters, as what normally gets
- * returned under locale doesn't work */
+ /* Special case these characters, as what normally gets returned
+ * under locale doesn't work */
if (memBEGINs((char *) p, e - p, CAP_SHARP_S))
{
/* diag_listed_as: Can't do %s("%s") on non-UTF-8 locale; resolved to "%s". */
@@ -4546,6 +4548,17 @@ Perl_to_utf8_fold_flags_(pTHX_ const U8 *p,
"resolved to \"\\x{17F}\\x{17F}\".");
goto return_long_s;
}
+
+# ifdef SURSOLIDUM
+
+ if (memBEGINs((char *) p, e - p, LATIN_SMALL_LIGATURE_LONG_S_WITH_DESCENDER_S_UTF8)) {
+ /* diag_listed_as: Can't do %s("%s") on non-UTF-8 locale; resolved to "%s". */
+ ck_warner(packWARN(WARN_LOCALE),
+ "Can't do fc(\"\\x{1DF95}\") on non-UTF-8 locale; "
+ "resolved to \"\\x{17F}\\x{17F}\".");
+ goto return_long_s;
+ }
+# endif
#endif
if (memBEGINs((char *) p, e - p, LONG_S_T)) {
/* diag_listed_as: Can't do %s("%s") on non-UTF-8 locale; resolved to "%s". */
@@ -4600,6 +4613,9 @@ Perl_to_utf8_fold_flags_(pTHX_ const U8 *p,
if (original == LATIN_SMALL_LETTER_SHARP_S
#ifdef LATIN_CAPITAL_LETTER_SHARP_S /* not defined in early Unicode releases */
|| original == LATIN_CAPITAL_LETTER_SHARP_S
+#endif
+#ifdef SURSOLIDUM /* not defined in early Unicode releases */
+ || original == SURSOLIDUM
#endif
) {
goto return_long_s;
diff --git a/utf8.h b/utf8.h
index 367c2f1b45..70f7c3055c 100644
--- a/utf8.h
+++ b/utf8.h
@@ -1426,6 +1426,10 @@ See C<L</uv_to_utf8_flags>> for the modern flags to use.
#ifdef LATIN_CAPITAL_LETTER_SHARP_S_UTF8
# define LATIN_CAPITAL_LETTER_SHARP_S 0x1E9E
#endif
+#ifdef LATIN_SMALL_LIGATURE_LONG_S_WITH_DESCENDER_S_UTF8
+# define LATIN_SMALL_LIGATURE_LONG_S_WITH_DESCENDER_S 0x1DF95
+# define SURSOLIDUM LATIN_SMALL_LIGATURE_LONG_S_WITH_DESCENDER_S
+#endif
#define LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE 0x130
#define LATIN_SMALL_LETTER_DOTLESS_I 0x131
#define LATIN_SMALL_LETTER_LONG_S 0x017F