This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regex: Speed up \X processing
authorKarl Williamson <public@khwilliamson.com>
Tue, 21 Aug 2012 04:03:22 +0000 (22:03 -0600)
committerKarl Williamson <public@khwilliamson.com>
Sun, 26 Aug 2012 05:21:30 +0000 (23:21 -0600)
For most Unicode releases, GCB=prepend matches absolutely nothing.  And
that appears to be the case going forward, as they added things to it,
and removed them later based on field experience.

An earlier commit has improved the performance of this significantly by
using a binary search of an empty array instead of a swash hash.
However, that search requires several layers of function calls to
discover that it is empty, which this commit avoids.

This patch will use whatever swash_init() returns unless it is empty,
preserving backwards compatibility with older Unicode releases.  But if
it is empty, the routine sets things up so that future calls will always
fail without further testing.

regexec.c
utf8.c

index 7961141..27ad2d8 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -3996,14 +3996,17 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 
                    LOAD_UTF8_CHARCLASS_GCB();
 
-                   /* Match (prepend)* */
+                    /* Match (prepend)*, but don't bother trying if empty (as
+                     * being set to _undef indicates) */
+                    if (PL_utf8_X_prepend != &PL_sv_undef) {
                    while (locinput < PL_regeol
                           && swash_fetch(PL_utf8_X_prepend,
                                          (U8*)locinput, utf8_target))
-                   {
+                    {
                        previous_prepend = locinput;
                        locinput += UTF8SKIP(locinput);
                    }
+                    }
 
                    /* As noted above, if we matched a prepend character, but
                     * the next thing won't match, back off the last prepend we
diff --git a/utf8.c b/utf8.c
index 0da2c01..8cc05c3 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -2232,11 +2232,41 @@ Perl_is_utf8_X_extend(pTHX_ const U8 *p)
 bool
 Perl_is_utf8_X_prepend(pTHX_ const U8 *p)
 {
+    /* If no code points in the Unicode version being worked on match
+     * GCB=Prepend, this will set PL_utf8_X_prepend to &PL_sv_undef during its
+     * first call.  Otherwise, it will set it to a swash created for it.
+     * swash_fetch() hence can't be used without checking first if it is valid
+     * to do so. */
+
     dVAR;
+    bool initialized = cBOOL(PL_utf8_X_prepend);
+    bool ret;
 
     PERL_ARGS_ASSERT_IS_UTF8_X_PREPEND;
 
-    return is_utf8_common(p, &PL_utf8_X_prepend, "_X_GCB_Prepend");
+    if (PL_utf8_X_prepend == &PL_sv_undef) {
+        return FALSE;
+    }
+
+    if ((ret = is_utf8_common(p, &PL_utf8_X_prepend, "_X_GCB_Prepend"))
+        || initialized)
+    {
+        return ret;
+    }
+
+    /* Here the code point being checked was not a prepend, and we hadn't
+     * initialized PL_utf8_X_prepend, so we don't know if it is just this
+     * particular input code point that didn't match, or if the table is
+     * completely empty. The is_utf8_common() call did the initialization, so
+     * we can inspect the swash's inversion list to find out.  If there are no
+     * elements in its inversion list, it's empty, and nothing will ever match,
+     * so set things up so we can skip the check in future calls. */
+    if (_invlist_len(_get_swash_invlist(PL_utf8_X_prepend)) == 0) {
+        SvREFCNT_dec(PL_utf8_X_prepend);
+        PL_utf8_X_prepend = &PL_sv_undef;
+    }
+
+    return FALSE;
 }
 
 bool