master be9db2b: Fix pcase 'rx' patterns with a single named submatch (bug#48477)

[Mattias Engdegård]

branch: master
commit be9db2b94d31a0afe3f93302558b3a78605244c7
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Fix pcase 'rx' patterns with a single named submatch (bug#48477)
    
    pcase 'rx' patterns with a single named submatch, like
    
      (rx (let x "a"))
    
    would always succeed because of an over-optimistic transformation.
    Patterns with 0 or more than 1 named submatches were not affected.
    
    Reported by Philipp Stephani.
    
    * lisp/emacs-lisp/rx.el (rx--pcase-macroexpander):
    Special case for a single named submatch.
    * test/lisp/emacs-lisp/rx-tests.el (rx-pcase): Add tests.
---
 lisp/emacs-lisp/rx.el            | 21 ++++++++++++++++-----
 test/lisp/emacs-lisp/rx-tests.el | 14 ++++++++++++++
 2 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 1e3eb9c..43bd84d 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1445,12 +1445,23 @@ following constructs:
          (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps))))
          (nvars (length rx--pcase-vars)))
     `(and (pred stringp)
-          ,(if (zerop nvars)
-               ;; No variables bound: a single predicate suffices.
-               `(pred (string-match ,regexp))
+          ,(pcase nvars
+            (0
+             ;; No variables bound: a single predicate suffices.
+             `(pred (string-match ,regexp)))
+            (1
+             ;; Create a match value that on a successful regexp match
+             ;; is the submatch value, 0 on failure.  We can't use nil
+             ;; for failure because it is a valid submatch value.
+             `(app (lambda (s)
+                     (if (string-match ,regexp s)
+                         (match-string 1 s)
+                       0))
+                   (and ,(car rx--pcase-vars) (pred (not numberp)))))
+            (_
              ;; Pack the submatches into a dotted list which is then
              ;; immediately destructured into individual variables again.
-             ;; This is of course slightly inefficient when NVARS > 1.
+             ;; This is of course slightly inefficient.
              ;; A dotted list is used to reduce the number of conses
              ;; to create and take apart.
              `(app (lambda (s)
@@ -1463,7 +1474,7 @@ following constructs:
                           (rx--reduce-right
                            #'cons
                            (mapcar (lambda (name) (list '\, name))
-                                   (reverse rx--pcase-vars)))))))))
+                                   (reverse rx--pcase-vars))))))))))
 
 ;; Obsolete internal symbol, used in old versions of the `flycheck' package.
 (define-obsolete-function-alias 'rx-submatch-n 'rx-to-string "27.1")
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 2dd1bca..4828df0 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -166,6 +166,20 @@
                         (backref 1))
                     (list u v)))
                  '("1" "3")))
+  (should (equal (pcase "bz"
+                   ((rx "a" (let x nonl)) (list 1 x))
+                   (_ 'no))
+                 'no))
+  (should (equal (pcase "az"
+                   ((rx "a" (let x nonl)) (list 1 x))
+                   ((rx "b" (let x nonl)) (list 2 x))
+                   (_ 'no))
+                 '(1 "z")))
+  (should (equal (pcase "bz"
+                   ((rx "a" (let x nonl)) (list 1 x))
+                   ((rx "b" (let x nonl)) (list 2 x))
+                   (_ 'no))
+                 '(2 "z")))
   (let ((k "blue"))
     (should (equal (pcase "<blue>"
                      ((rx "<" (literal k) ">") 'ok))