PATCH: [perl 134335], gh115,Assert fail in regmatch

This happens when the regular expression pattern, compiling under /il,
ends up with a node attempting to match one of 17 Unicode characters
that fold (/i) to multiple characters in the 0-FF range, and the match
is run when a UTF-8 locale is in effect that makes such a match legal.
The node was being marked as SIMPLE, but only nodes that match a single
character should be SIMPLE.

This ticket was originally filed as a security issue, but I don't think
it is.  If I remove the assertion, the match fails, without an
out-of-bounds access.  And we do not consider the interpreter crashing
on a DEBUGGING build a security issue.

(cherry picked from commit 2df0dd21423ddf295fe2e5d2a6665300f4c5dd94)

2 files changed, 26 insertions, 1 deletions

diff --git a/regcomp.c b/regcomp.c
index fce1e6fa45..88282081a8 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -14738,6 +14738,21 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
                         if (maybe_exactfu) {
                             node_type = EXACTFLU8;
                         }
+                        else if (UNLIKELY(
+                             _invlist_contains_cp(PL_HasMultiCharFold, ender)))
+                        {
+                            /* A character that folds to more than one will
+                             * match multiple characters, so can't be SIMPLE.
+                             * We don't have to worry about this with EXACTFLU8
+                             * nodes just above, as they have already been
+                             * folded (since the fold doesn't vary at run
+                             * time).  Here, if the final character in the node
+                             * folds to multiple, it can't be simple.  (This
+                             * only has an effect if the node has only a single
+                             * character, hence the final one, as elsewhere we
+                             * turn off simple for nodes whose length > 1 */
+                            maybe_SIMPLE = 0;
+                        }
                     }
                     else if (node_type == EXACTF) {  /* Means is /di */
 
diff --git a/t/re/pat.t b/t/re/pat.t
index 6a868f4bcd..c215649a47 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -25,7 +25,7 @@ BEGIN {
 skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
 skip_all_without_unicode_tables();
 
-plan tests => 864;  # Update this when adding/deleting tests.
+plan tests => 865;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -2115,6 +2115,16 @@ x{0c!}\;\;îçÿ 
         like(runperl(prog => "$s", stderr => 1), qr/Unmatched \(/);
    }
 
+SKIP:
+    {   # [perl #134334], Assertion failure
+        my $utf8_locale = find_utf8_ctype_locale();
+        skip "no UTF-8 locale available" unless $utf8_locale;
+        fresh_perl_like("use POSIX; POSIX::setlocale(&LC_CTYPE, '$utf8_locale'); 'ssss' =~ /\xDF+?sX/il;",
+                        qr/^$/,
+                        {},
+                        "Assertion failure matching /il on single char folding to multi");
+    }
+
 } # End of sub run_tests
 
 1;