Rewrite flex completion scoring with Gotoh algorithmfeature/newflex

The greedy regexp matching, broken scoring and broken highlight were
sources of frequent complaints about the 'flex' matching style.  This
commit fixes that.

It was inspired by the 'hotfuzz' style available at
https://github.com/axelf4/hotfuzz which is a modified version of Gotoh's
1982 dynamic programming algorithm (see: GOTOH, Osamu. An improved
algorithm for matching biological sequences. Journal of molecular
biology, 1982, 162.3: 705-708.).  That style is slightly more
sophisticated than 'flex' (has special rules for matching things at word
boundaries, a C module with multithreading support).  It's almost (but not
entirely) void of hacks so it'd make a good candidate to replace 'flex'
entirely, but no progress has been made in getting it into Emacs's core
in over 2 years, so I thought I'd try my hand at it.

The new 'flex' implementation also uses Gotoh algorithm (apparently
a common choice for these kinds of task) and happens mostly in a new C
function.  It is strictly more correct than the "old" flex.  For
example, when matching the pattern 'goto' to, say, 'eglot--goto' and
'eglot--bol', no longer is the latter returned first, which was a
substantial annoyance.  And of course the highlighting is also correctly
placed on the 'goto' not scattered across the candidate.

Regarding performance, it is faster than the naive 'flex', but that's
mainly because this commit also includes changes to the Elisp code which
make faster regexp's for the filtering step.  It is slower than
'hotfuzz' when that style's C-module extension is leveraged.  'hotfuzz'
does the filtering and sorting steps together in C code and has
multithreaded workers there.  The matching and scoring algorithm itself
is not the bottleneck.

Test code were refactored and more tests were added.

* src/minibuf.c (completion--flex-score-gotoh): New function.

* lisp/minibuffer.el (completion--flex-score): Rewrite.
(completion--flex-propertize): New function.
(completion-flex--pattern-str): New variable.
(flex-score-match-tightness): Make obsolete.
(completion-pcm--all-completions): Add optional override-re parameter.
(completion-pcm--hilit-commonality): No more re-based highlighting.
(completion-substring--all-completions): Add optional simple-re parameters.
(completion--flex-adjust-metadata): Tweak to new scoring API.
(completion-flex-try-completion, completion-flex-all-completions):
Pass simple-re parameter to completion-substring--all-completions.
(completion--hilit-from-re, completion--flex-score-1)
(completion--flex-score-last-md, completion-pcm--regexp): Delete.

* test/lisp/minibuffer-tests.el (completion--sorted-flex-completions):
New helper function.
(completion-flex-test-non-ascii): New test.
(completion--pcm-score): Delete.
(completion-pcm-test-3, completion-pcm-test-4)
(completion-substring-test-1, completion-substring-test-2)
(completion-flex-test-2, completion-flex-test-3): Remove old scoring
expectations.

3 files changed, 347 insertions, 205 deletions

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index fc193fe54f0..5b5408a595c 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -4421,9 +4421,12 @@ This is used in combination with `completion-pcm--segments->regex'."
         (setq idx i)))
     idx))
 
-(defun completion-pcm--all-completions (prefix pattern table pred)
+(defun completion-pcm--all-completions (prefix pattern table pred
+                                               &optional override-re)
   "Find all completions for PATTERN in TABLE obeying PRED.
-PATTERN is as returned by `completion-pcm--string->pattern'."
+PATTERN is as returned by `completion-pcm--string->pattern'.
+OVERRIDE-RE means to use this regular expression instead of grabbing one
+from PATTERN."
   ;; (cl-assert (= (car (completion-boundaries prefix table pred ""))
   ;;            (length prefix)))
   ;; Find an initial list of possible completions.
@@ -4435,7 +4438,7 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
     ;; Use all-completions to do an initial cull.  This is a big win,
     ;; since all-completions is written in C!
     (let* (;; Convert search pattern to a standard regular expression.
-           (regex (completion-pcm--pattern->regex pattern))
+           (regex (or override-re (completion-pcm--pattern->regex pattern)))
            (case-fold-search completion-ignore-case)
            (completion-regexp-list (cons regex completion-regexp-list))
            (compl (all-completions
@@ -4450,18 +4453,12 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
             (when (string-match-p regex c) (push c poss)))
           (nreverse poss))))))
 
-(defvar flex-score-match-tightness 3
-  "Controls how the `flex' completion style scores its matches.
+(defvar flex-score-match-tightness nil)
 
-Value is a positive number.  A number smaller than 1 makes the
-scoring formula reward matches scattered along the string, while
-a number greater than one make the formula reward matches that
-are clumped together.  I.e \"foo\" matches both strings
-\"fbarbazoo\" and \"fabrobazo\", which are of equal length, but
-only a value greater than one will score the former (which has
-one large \"hole\" and a clumped-together \"oo\" match) higher
-than the latter (which has two \"holes\" and three
-one-letter-long matches).")
+(make-obsolete-variable
+ 'flex-score-match-tightness
+ "It never did anything very useful anyway."
+ "31.0")
 
 (defvar completion-lazy-hilit nil
   "If non-nil, request lazy highlighting of completion candidates.
@@ -4502,133 +4499,49 @@ details."
       (funcall completion-lazy-hilit-fn (copy-sequence str))
     str))
 
-(defun completion--hilit-from-re (string regexp &optional point-idx)
-  "Fontify STRING using REGEXP POINT-IDX.
-Uses `completions-common-part' and `completions-first-difference'
-faces to fontify STRING.
-POINT-IDX is the position of point in the presumed \"PCM\" pattern
-from which REGEXP was generated."
-  (let* ((md (and regexp (string-match regexp string) (cddr (match-data t))))
-         (pos (if point-idx (match-beginning point-idx) (match-end 0)))
-         (me (and md (match-end 0)))
-         (from 0))
-    (while md
-      (add-face-text-property from (pop md)
-                              'completions-common-part nil string)
-      (setq from (pop md)))
-    (if (and (numberp pos) (> (length string) pos))
-        (add-face-text-property
-         pos (1+ pos)
-         'completions-first-difference
-         nil string))
-    (unless (or (not me) (= from me))
-      (add-face-text-property from me 'completions-common-part nil string))
-    string))
-
-(defun completion--flex-score-1 (md-groups match-end len)
-  "Compute matching score of completion.
-The score lies in the range between 0 and 1, where 1 corresponds to
-the full match.
-MD-GROUPS is the \"group\"  part of the match data.
-MATCH-END is the end of the match.
-LEN is the length of the completion string."
-  (let* ((from 0)
-         ;; To understand how this works, consider these simple
-         ;; ascii diagrams showing how the pattern "foo"
-         ;; flex-matches "fabrobazo", "fbarbazoo" and
-         ;; "barfoobaz":
-
-         ;;      f abr o baz o
-         ;;      + --- + --- +
-
-         ;;      f barbaz oo
-         ;;      + ------ ++
-
-         ;;      bar foo baz
-         ;;          +++
-
-         ;; "+" indicates parts where the pattern matched.  A
-         ;; "hole" in the middle of the string is indicated by
-         ;; "-".  Note that there are no "holes" near the edges
-         ;; of the string.  The completion score is a number
-         ;; bound by (0..1] (i.e., larger than (but not equal
-         ;; to) zero, and smaller or equal to one): the higher
-         ;; the better and only a perfect match (pattern equals
-         ;; string) will have score 1.  The formula takes the
-         ;; form of a quotient.  For the numerator, we use the
-         ;; number of +, i.e. the length of the pattern.  For
-         ;; the denominator, it first computes
-         ;;
-         ;;     hole_i_contrib = 1 + (Li-1)^(1/tightness)
-         ;;
-         ;; , for each hole "i" of length "Li", where tightness
-         ;; is given by `flex-score-match-tightness'.  The
-         ;; final value for the denominator is then given by:
-         ;;
-         ;;    (SUM_across_i(hole_i_contrib) + 1) * len
-         ;;
-         ;; , where "len" is the string's length.
-         (score-numerator 0)
-         (score-denominator 0)
-         (last-b 0))
-    (while (and md-groups (car md-groups))
-      (let ((a from)
-            (b (pop md-groups)))
-        (setq
-         score-numerator   (+ score-numerator (- b a)))
-        (unless (or (= a last-b)
-                    (zerop last-b)
-                    (= a len))
-          (setq
-           score-denominator (+ score-denominator
-                                1
-                                (expt (- a last-b 1)
-                                      (/ 1.0
-                                         flex-score-match-tightness)))))
-        (setq
-         last-b              b))
-      (setq from (pop md-groups)))
-    ;; If `pattern' doesn't have an explicit trailing any, the
-    ;; regex `re' won't produce match data representing the
-    ;; region after the match.  We need to account to account
-    ;; for that extra bit of match (bug#42149).
-    (unless (= from match-end)
-      (let ((a from)
-            (b match-end))
-        (setq
-         score-numerator   (+ score-numerator (- b a)))
-        (unless (or (= a last-b)
-                    (zerop last-b)
-                    (= a len))
-          (setq
-           score-denominator (+ score-denominator
-                                1
-                                (expt (- a last-b 1)
-                                      (/ 1.0
-                                         flex-score-match-tightness)))))
-        (setq
-         last-b              b)))
-    (/ score-numerator (* len (1+ score-denominator)) 1.0)))
-
-(defvar completion--flex-score-last-md nil
-  "Helper variable for `completion--flex-score'.")
-
-(defun completion--flex-score (str re &optional dont-error)
-  "Compute flex score of completion STR based on RE.
-If DONT-ERROR, just return nil if RE doesn't match STR."
-  (let ((case-fold-search completion-ignore-case))
-    (cond ((string-match re str)
-           (let* ((match-end (match-end 0))
-                  (md (cddr
-                       (setq
-                        completion--flex-score-last-md
-                        (match-data t completion--flex-score-last-md)))))
-             (completion--flex-score-1 md match-end (length str))))
-          ((not dont-error)
-           (error "Internal error: %s does not match %s" re str)))))
-
-(defvar completion-pcm--regexp nil
-  "Regexp from PCM pattern in `completion-pcm--hilit-commonality'.")
+(cl-defun completion--flex-score (pat str &optional dont-error)
+  "Compute flex score of STR matching PAT using Gotoh algorithm.
+If DONT-ERROR, return nil if PAT cannot match STR.
+Return (NORMALIZED-COST . MATCHES) where NORMALIZED-COST is a
+number (lower = better) and MATCHES is a list of match positions in STR."
+  (pcase-let ((`(,cost . ,matches)
+               (completion--flex-score-gotoh pat str)))
+    (unless cost
+      (if dont-error (cl-return-from completion--flex-score nil)
+        (error "Pattern %s does not match %s" pat str)))
+    (cons (* (1+ cost) (- (length str) (length pat))) matches)))
+
+(defun completion--flex-propertize (str matches point-idx segments)
+  "Add completion faces to STR based on MATCHES and POINT-IDX.
+MATCHES is a list of match positions.  POINT-IDX is a match group index
+from the PCM pattern.  SEGMENTS are extracted from the full PCM pattern.
+Adds `completions-common-part' for matched positions and
+`completions-first-difference' for the position corresponding to point."
+  (when point-idx
+    ;; Compute character position from segments
+    (let* ((pos (cl-loop for seg in segments
+                         for i from 1
+                         while (<= i point-idx)
+                         sum (length (car seg)))))
+      ;; Add first-difference after pos-th match, if in range
+      (let ((point-match (and (> pos 0)
+                              (<= pos (length matches))
+                              (nth (1- pos) matches))))
+        (when (and point-match (< (1+ point-match) (length str)))
+          (add-face-text-property
+           (1+ point-match) (+ 2 point-match)
+           'completions-first-difference nil str)))))
+  ;; Highlight matched positions
+  (dolist (pos matches)
+    (add-face-text-property pos (1+ pos)
+                           'completions-common-part
+                           nil str))
+  str)
+
+(defvar completion-flex--pattern-str nil
+  "Pattern string for flex completion scoring.
+This is the concatenated string parts from the PCM pattern,
+used by `completion--flex-score' for Gotoh algorithm matching.")
 
 (defun completion-pcm--hilit-commonality (pattern completions)
   "Show where and how well PATTERN matches COMPLETIONS.
@@ -4645,22 +4558,37 @@ relevant segments.
 Else, if `completion-lazy-hilit' is t, return COMPLETIONS
 unchanged, but setup a suitable `completion-lazy-hilit-fn' (which
 see) for later lazy highlighting."
-  (setq completion-pcm--regexp nil
-        completion-lazy-hilit-fn nil)
+  (setq completion-lazy-hilit-fn nil
+        completion-flex--pattern-str nil)
   (cond
    ((and completions (cl-loop for e in pattern thereis (stringp e)))
     (let* ((segments (completion-pcm--pattern->segments pattern))
-           (re (completion-pcm--segments->regex segments 'group))
-           (point-idx (completion-pcm--segments-point-idx segments)))
-      (setq completion-pcm--regexp re)
+           (point-idx (completion-pcm--segments-point-idx segments))
+           ;; Extract pattern string (concatenate string elements)
+           (pat (mapconcat #'identity
+                           (delq nil (mapcar (lambda (x)
+                                               (if (stringp x) x nil))
+                                             pattern))
+                           "")))
+      (setq completion-flex--pattern-str pat)
       (cond (completion-lazy-hilit
              (setq completion-lazy-hilit-fn
-                   (lambda (str) (completion--hilit-from-re str re point-idx)))
+                   (lambda (str)
+                     (let ((result (completion--flex-score pat str t)))
+                       (when result
+                         (completion--flex-propertize
+                          str (cdr result) point-idx segments)))
+                     str))
              completions)
             (t
              (mapcar
               (lambda (str)
-                (completion--hilit-from-re (copy-sequence str) re point-idx))
+                (setq str (copy-sequence str))
+                (let ((result (completion--flex-score pat str t)))
+                  (when result
+                    (completion--flex-propertize
+                     str (cdr result) point-idx segments)))
+                str)
               completions)))))
    (t completions)))
 
@@ -4959,11 +4887,13 @@ the same set of elements."
 ;; Mostly derived from the code of `basic' completion.
 
 (defun completion-substring--all-completions
-    (string table pred point &optional transform-pattern-fn)
+    (string table pred point &optional
+            transform-pattern-fn simple-re)
   "Match the presumed substring STRING to the entries in TABLE.
-Respect PRED and POINT.  The pattern used is a PCM-style
-substring pattern, but it be massaged by TRANSFORM-PATTERN-FN, if
-that is non-nil."
+Respect PRED and POINT.  The pattern used is a PCM-style substring
+pattern, but it be massaged by TRANSFORM-PATTERN-FN, if that is non-nil.
+SIMPLE-RE is means to pass a simpler faster regular expression to
+`completion-pcm--all-completions'"
   (let* ((beforepoint (substring string 0 point))
          (afterpoint (substring string point))
          (bounds (completion-boundaries beforepoint table pred afterpoint))
@@ -4978,7 +4908,13 @@ that is non-nil."
                    (if transform-pattern-fn
                        (funcall transform-pattern-fn pattern)
                      pattern)))
-         (all (completion-pcm--all-completions prefix pattern table pred)))
+         (override-re (and simple-re
+                           (mapconcat #'identity
+                                      (split-string
+                                       (substring string (car bounds)
+                                                  (+ point (cdr bounds))) "" t)
+                                      ".*")))
+         (all (completion-pcm--all-completions prefix pattern table pred override-re)))
     (list all pattern prefix suffix (car bounds))))
 
 (defun completion-substring-try-completion (string table pred point)
@@ -5009,7 +4945,7 @@ that is non-nil."
 
 (defun completion--flex-adjust-metadata (metadata)
   "If `flex' is actually doing filtering, adjust sorting."
-  (let ((flex-is-filtering-p completion-pcm--regexp)
+  (let ((flex-is-filtering-p completion-flex--pattern-str)
         (existing-dsf
          (completion-metadata-get metadata 'display-sort-function))
         (existing-csf
@@ -5021,11 +4957,11 @@ that is non-nil."
                              (mapcar
                               (lambda (str)
                                 (cons
-                                 (- (completion--flex-score
-                                     (or (get-text-property
-                                          0 'completion--unquoted str)
-                                         str)
-                                     completion-pcm--regexp))
+                                 (car (completion--flex-score
+                                       completion-flex--pattern-str
+                                       (or (get-text-property
+                                            0 'completion--unquoted str)
+                                           str)))
                                  str))
                               (if existing-sort-fn
                                   (funcall existing-sort-fn completions)
@@ -5067,7 +5003,8 @@ which is at the core of flex logic.  The extra
     (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
                  (completion-substring--all-completions
                   string table pred point
-                  #'completion-flex--make-flex-pattern)))
+                  #'completion-flex--make-flex-pattern
+                  t)))
       (if minibuffer-completing-file-name
           (setq all (completion-pcm--filename-try-filter all)))
       ;; Try some "merging", meaning add as much as possible to the
@@ -5084,7 +5021,8 @@ which is at the core of flex logic.  The extra
     (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
                  (completion-substring--all-completions
                   string table pred point
-                  #'completion-flex--make-flex-pattern)))
+                  #'completion-flex--make-flex-pattern
+                  t)))
       (when all
         (nconc (completion-pcm--hilit-commonality pattern all)
                (length prefix))))))
diff --git a/src/minibuf.c b/src/minibuf.c
index 5dc2b230883..f7dffc24b94 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -20,6 +20,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 #include <config.h>
 #include <errno.h>
+#include <math.h>
 
 #include <binary-io.h>
 
@@ -2279,6 +2280,201 @@ init_minibuf_once_for_pdumper (void)
   last_minibuf_string = Qnil;
 }
 
+/* FLEX/GOTOH algorithm for the 'flex' completion-style.  Adapted from
+   GOTOH, Osamu. An improved algorithm for matching biological
+   sequences. Journal of molecular biology, 1982, 162.3: 705-708.
+
+   This algorithm matches patterns to candidate strings, or needles to
+   haystacks.  It works with cost matrices: imagine rows of these
+   matrices as pattern characters, and columns as the candidate string
+   characters.  There is a -1 row, and a -1 column.  The values there
+   hold real costs used for situations "before the first ever" match of
+   a pattern character to a string character.
+
+   M and D are cost matrices.  At the end of the algorithm, M will have
+   non-infinite values only for the spots where a pattern character
+   matches a string character.  So a non-infinite M[i,j] means the i-th
+   character of the pattern matches the j-th character of the string.
+   The value stored is the lowest possible cost the algorithm had to
+   "pay" to be able to make that match there, given everything that may
+   have happened before/to the left.  An infinite value simply means no
+   match at this pattern/string position.  Note that both row and column
+   of M may have more than one match at multiple indices.  But this
+   particular implementation of the algorithm assumes they have at least
+   one match.
+
+   D (originally stands for 'Deletion' in the Gotoh paper) has "running
+   costs".  Each value D[i,j] represents what the algorithm has to pay
+   to make or extend a gap when a match is found at i+1, j+1.  By that
+   time, that cost may or may not be lower than continuing from a match
+   that had also been found at i,j.  We always pick the lowest cost, and
+   by the time we reach the final column, we know we have picked the
+   cheapest possible path choosing when to gap, and when to follow up.
+
+   Along the way, we construct P, a matrix used just for backtracking,
+   to reconstruct that path.  Maybe P isn't needed, and all the
+   information can be cleverly derived from the final state of M and D.
+   But I couldn't make it work.  */
+DEFUN ("completion--flex-score-gotoh", Fcompletion__flex_score_gotoh,
+       Scompletion__flex_score_gotoh, 2, 2, 0,
+       doc: /* Compute flex score of STR matching PAT using Gotoh
+algorithm.  Return nil if no match found, else return (COST . MATCHES)
+where COST is a fixnum (lower is better) and MATCHES is a list of match
+positions in STR.  */)
+  (Lisp_Object pat, Lisp_Object str)
+{
+  /* Pre-allocated matrices for flex completion scoring.  */
+#define FLEX_MAX_STR_SIZE 512
+#define FLEX_MAX_PAT_SIZE 128
+#define FLEX_MAX_MATRIX_SIZE FLEX_MAX_PAT_SIZE * FLEX_MAX_STR_SIZE
+  /* Macro for 2D indexing into "flat" arrays.  */
+#define MAT(matrix, i, j) ((matrix)[((i) + 1) * width + ((j) + 1)])
+
+  CHECK_STRING (pat);
+  CHECK_STRING (str);
+
+  size_t patlen = SCHARS (pat);
+  size_t strlen = SCHARS (str);
+  size_t width = strlen + 1;
+  size_t size = (patlen + 1) * width;
+
+  /* Bail if strings are empty or matrix too large.  */
+  if (patlen == 0 || strlen == 0)
+    return Qnil;
+
+  if (size > FLEX_MAX_MATRIX_SIZE)
+    return Qnil;
+
+  /* Cost constants (lower is better).  Maybe these could be
+     defcustom's?*/
+  const int gap_open_cost = 10;
+  const int gap_extend_cost = 1;
+  const int pos_inf = INT_MAX / 2;
+
+  static int M[FLEX_MAX_MATRIX_SIZE];
+  static int D[FLEX_MAX_MATRIX_SIZE];
+  static size_t P[FLEX_MAX_MATRIX_SIZE];
+
+  /* Initialize costs.  Fill both matrices with positive infinity.  */
+  for (int j = 0; j < size; j++) M[j] = pos_inf;
+  for (int j = 0; j < size; j++) D[j] = pos_inf;
+  /* Except for D[0,0], which is 0, for prioritizing matches at the
+     beginning.  Remaining elements on the first row are gap_open_cost/2
+     to represent cheaper leading gaps. */
+  for (int j = 0; j < width; j++) D[j] = gap_open_cost/2;
+  D[0] = 0;
+
+  /* Index of last match before gap started, as computed in the previous
+     row.  Used to build P.  */
+  int prev_gap_origin = -1;
+
+  /* Poor man's iterator type. */
+  typedef struct iter { int x; ptrdiff_t c; ptrdiff_t b; } iter_t;
+
+  /* Info about first match computed in the previous row. */
+  iter_t prev_match = {0,0,0};
+  /* Forward pass.  */
+  for (iter_t i = {0,0,0}; i.x < patlen; i.x++)
+    {
+      int pat_char = fetch_string_char_advance(pat, &i.c, &i.b);
+      int gap_origin = -1;
+      bool match_seen = false;
+
+      for (iter_t j = prev_match; j.x < strlen; j.x++)
+        {
+          iter_t jcopy = j; /* else advance function destroys it... */
+          int str_char
+            = fetch_string_char_advance (str, &j.c, &j.b);
+
+          /* Check if characters match (case-insensitive if needed).  */
+          bool cmatch;
+          if (completion_ignore_case)
+            cmatch = (downcase (pat_char) == downcase (str_char));
+          else
+            cmatch = (pat_char == str_char);
+
+          /* Compute match cost M[i][j], i.e. replace its infinite
+             value with something finite. */
+          if (cmatch)
+            {
+              if (!match_seen)
+                {
+                  match_seen = true;
+                  prev_match = jcopy;
+                }
+              int pmatch_cost = MAT (M, i.x - 1, j.x - 1);
+              int pgap_cost = MAT (D, i.x - 1, j.x - 1);
+
+              if (pmatch_cost <= pgap_cost)
+                {
+                  /* Not only did the previous char also match (else
+                     pmatch_cost would have been infinite) but following
+                     it up with this match is best overall.  */
+                  MAT (M, i.x, j.x) = pmatch_cost;
+                  MAT (P, i.x, j.x) = j.x - 1;
+                }
+              else
+                {
+                  /* Gapping is best, regardless of whether the previous
+                     char also matched.  That is, it's better to arrive at
+                     this match from a gap.  */
+                  MAT (M, i.x, j.x) = pgap_cost;
+                  MAT (P, i.x, j.x) = prev_gap_origin;
+                }
+            }
+
+          /* Regardless of a match here, compute D[i,j], the best
+             accumulated gapping cost at this point, considering whether
+             it's more advantageous to open from a previous match on
+             this row (a cost which may well be infinite if no such
+             match ever existed) or extend a gap started sometime
+             before.  The next iteration will take this into account,
+             and so will the next row when analyzing a possible match
+             for the j+1-th string character.  */
+          int open_cost = MAT (M, i.x, j.x - 1) + gap_open_cost;
+          int extend_cost = MAT (D, i.x, j.x - 1) + gap_extend_cost;
+
+          if (open_cost < extend_cost)
+            {
+              MAT (D, i.x, j.x) = open_cost;
+              gap_origin = j.x - 1; /* New gap. */
+            }
+          else
+            MAT (D, i.x, j.x) = extend_cost; /* Extend gap.  */
+        }
+      prev_gap_origin = gap_origin;
+    }
+
+  /* Find best (lowest) cost in last row.  */
+  int best_cost = pos_inf;
+  int lastcol = -1;
+
+  for (int j = 0; j < strlen; j++)
+    {
+      int cost = MAT (M, patlen - 1, j);
+      if (cost < best_cost)
+        {
+          best_cost = cost;
+          lastcol = j;
+        }
+    }
+
+  if (lastcol < 0 || best_cost >= pos_inf)
+    return Qnil;
+
+  /* Build match positions list by tracing back through P matrix.  */
+  Lisp_Object matches = Qnil;
+  for (int i = patlen - 1, l = lastcol; i >= 0 && l >= 0; i--)
+    {
+      matches = Fcons (make_fixnum (l), matches);
+      l = MAT (P, i, l);
+    }
+
+  return Fcons (make_fixnum (best_cost), matches);
+#undef MAT
+
+}
+
 void
 syms_of_minibuf (void)
 {
@@ -2541,6 +2737,7 @@ showing the *Completions* buffer, if any.  */);
   defsubr (&Stest_completion);
   defsubr (&Sassoc_string);
   defsubr (&Scompleting_read);
+  defsubr (&Scompletion__flex_score_gotoh);
   DEFSYM (Qminibuffer_quit_recursive_edit, "minibuffer-quit-recursive-edit");
   DEFSYM (Qinternal_complete_buffer, "internal-complete-buffer");
   DEFSYM (Qcompleting_read_function, "completing-read-function");
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 79ffb1d3fc7..02df7661c75 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -205,11 +205,6 @@
                   '("some/alpha" "base/epsilon" "base/delta"))
                  `("epsilon" "delta" "beta" "alpha" "gamma"  . 5))))
 
-(defun completion--pcm-score (comp)
-  "Get `completion-score' from COMP."
-  ;; FIXME, uses minibuffer.el implementation details
-  (completion--flex-score comp completion-pcm--regexp))
-
 (defun completion--pcm-first-difference-pos (comp)
   "Get `completions-first-difference' from COMP."
   (cl-loop for pos = (next-single-property-change 0 'face comp)
@@ -244,20 +239,11 @@
            "barfoobar")))
 
 (ert-deftest completion-pcm-test-3 ()
-  ;; Full match!
-  (should (eql
-           (completion--pcm-score
-            (car (completion-pcm-all-completions
-                  "R" '("R" "hello") nil 1)))
-           1.0)))
+  (should (car (completion-pcm-all-completions
+                "R" '("R" "hello") nil 1))))
 
 (ert-deftest completion-pcm-test-4 ()
-  ;; One fourth of a match and no match due to point being at the end
-  (should (eql
-           (completion--pcm-score
-            (car (completion-pcm-all-completions
-                  "RO" '("RaOb") nil 1)))
-           (/ 1.0 4.0)))
+  ;; No match due to point being at the end
   (should (null
            (completion-pcm-all-completions
             "RO" '("RaOb") nil 2))))
@@ -420,24 +406,14 @@
            "a")))
 
 (ert-deftest completion-substring-test-1 ()
-  ;; One third of a match!
   (should (equal
            (car (completion-substring-all-completions
                  "foo" '("hello" "world" "barfoobar") nil 3))
-           "barfoobar"))
-  (should (eql
-           (completion--pcm-score
-            (car (completion-substring-all-completions
-                  "foo" '("hello" "world" "barfoobar") nil 3)))
-           (/ 1.0 3.0))))
+           "barfoobar")))
 
 (ert-deftest completion-substring-test-2 ()
-  ;; Full match!
-  (should (eql
-           (completion--pcm-score
-            (car (completion-substring-all-completions
-                  "R" '("R" "hello") nil 1)))
-           1.0)))
+  (should (car (completion-substring-all-completions
+                "R" '("R" "hello") nil 1))))
 
 (ert-deftest completion-substring-test-3 ()
   ;; Substring match
@@ -495,39 +471,70 @@
            (completion-substring-try-completion "b" '("ab" "ab") nil 0)
            '("ab" . 2))))
 
+(defun completion--sorted-flex-completions (pat list &optional point)
+  "Flex test helper"
+  (let ((all (completion-flex-all-completions pat list nil point)))
+    (setcdr (last all) nil)
+    (sort all
+          (lambda (a b)
+            (< (car (completion--flex-score pat a))
+               (car (completion--flex-score pat b)))))))
+
 (ert-deftest completion-flex-test-1 ()
-  ;; Fuzzy match
   (should (equal
            (car (completion-flex-all-completions
                  "foo" '("hello" "world" "fabrobazo") nil 3))
            "fabrobazo")))
 
 (ert-deftest completion-flex-test-2 ()
-  ;; Full match!
-  (should (eql
-           (completion--pcm-score
-            (car (completion-flex-all-completions
-                  "R" '("R" "hello") nil 1)))
-           1.0)))
+  (should (car (completion--sorted-flex-completions
+                "R" '("R" "hello") 1))))
 
 (ert-deftest completion-flex-test-3 ()
-  ;; Another fuzzy match, but more of a "substring" one
   (should (equal
-           (car (completion-flex-all-completions
-                 "custgroup" '("customize-group-other-window") nil 4))
+           (car (completion--sorted-flex-completions
+                 "custgroup" '("customize-group-other-window") 4))
            "customize-group-other-window"))
   ;; `completions-first-difference' should be at the right place
   (should (equal
            (completion--pcm-first-difference-pos
-            (car (completion-flex-all-completions
-                  "custgroup" '("customize-group-other-window") nil 4)))
+            (car (completion--sorted-flex-completions
+                  "custgroup" '("customize-group-other-window") 4)))
            4))
   (should (equal
            (completion--pcm-first-difference-pos
-            (car (completion-flex-all-completions
-                  "custgroup" '("customize-group-other-window") nil 9)))
+            (car (completion--sorted-flex-completions
+                  "custgroup" '("customize-group-other-window") 9)))
            15)))
 
+(ert-deftest completion-flex-test-non-ascii ()
+  "Test flex completion with variable-width UTF-8 characters."
+  ;; Uses Japanese Kanji to test multi-byte character handling.
+
+  ;; 日本 = "nihon" (Japan), 東京 = "tōkyō" (Tokyo)
+  (should (equal
+           (car (completion--sorted-flex-completions
+                 "日本" '("日本語" "日本" "中国") 2))
+           "日本"))
+
+  ;; 図書館 = "toshokan" (library)
+  (should (equal
+           (car (completion--sorted-flex-completions
+                 "tsk" '("図書館-toshokan" "task" "desk") 3))
+           "task"))
+
+  ;; Mixed pattern (Kanji + ASCII) matching mixed string
+  ;; 学校 = "gakkō" (school)
+  (should (equal
+           (car (completion--sorted-flex-completions
+                 "学s" '("学校-school" "school" "学生") 2))
+           "学校-school"))
+
+  ;; Pattern "東" should match "東京" better than "関東"
+  (let ((results (completion--sorted-flex-completions
+                  "東" '("東京" "関東") 1)))
+    (should (equal (car results) "東京"))))
+
 
 (defmacro with-minibuffer-setup (completing-read &rest body)
   (declare (indent 1) (debug t))