]> git.eshelyaron.com Git - emacs.git/commitdiff
Fix pcase rx pattern bugs
authorMattias Engdegård <mattiase@acm.org>
Fri, 26 Feb 2021 08:52:16 +0000 (09:52 +0100)
committerMattias Engdegård <mattiase@acm.org>
Fri, 26 Feb 2021 09:09:42 +0000 (10:09 +0100)
Two unrelated bugs: A missing type check caused an error in rx
patterns for non-string match targets, and rx patterns did not work at
all in pcase-let or pcase-let*.

Second bug reported by Basil Contovounesios and Ag Ibragimov; fixes
proposed by Stefan Monnier.  Discussion and explanation in thread at
https://lists.gnu.org/archive/html/emacs-devel/2021-02/msg01924.html

* lisp/emacs-lisp/rx.el (rx): Add (pred stringp) to avoid type errors,
and replace the `pred` clause for the actual match with something that
works with pcase-let(*) without being optimised away.
* test/lisp/emacs-lisp/rx-tests.el (rx-pcase): Add test cases.

lisp/emacs-lisp/rx.el
test/lisp/emacs-lisp/rx-tests.el

index 58584f300c9cdb26d279b33c58489d6ad95c056d..ffc21951b647a7a7e458b0cf0a69cf8ec115e5d3 100644 (file)
@@ -1437,7 +1437,11 @@ following constructs:
                    construct."
   (let* ((rx--pcase-vars nil)
          (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps)))))
-    `(and (pred (string-match ,regexp))
+    `(and (pred stringp)
+          ;; `pcase-let' takes a match for granted and discards all unnecessary
+          ;; conditions, which means that a `pred' clause cannot be used for
+          ;; the match condition.  The following construct seems to survive.
+          (app (lambda (s) (string-match ,regexp s)) (pred identity))
           ,@(let ((i 0))
               (mapcar (lambda (name)
                         (setq i (1+ i))
index 12bf4f7978efad786713b4066aff0ece95bcd761..fecdcf55aff6a61ca436eb49be064b16079b0dd3 100644 (file)
   (should (equal (pcase "abc"
                    ((rx (? (let x alpha)) (?? (let y alnum)) ?c)
                     (list x y)))
-                 '("a" "b"))))
+                 '("a" "b")))
+  (should (equal (pcase 'not-a-string
+                   ((rx nonl) 'wrong)
+                   (_ 'correct))
+                 'correct))
+  (should (equal (pcase-let (((rx ?B (let z nonl)) "ABC"))
+                   (list 'ok z))
+                 '(ok "C")))
+  (should (equal (pcase-let* (((rx ?E (let z nonl)) "DEF"))
+                   (list 'ok z))
+                 '(ok "F"))))
 
 (ert-deftest rx-kleene ()
   "Test greedy and non-greedy repetition operators."