bug#68509: 30.0.50; pcase-dolist matches backquote pattern incorrectly

[Ihor Radchenko <yantar92@posteo.net>]

[-- Attachment #1: Type: text/plain, Size: 434 bytes --]

Ihor Radchenko <yantar92@posteo.net> writes:

> Not sure about pcase-let, but pcase-dolist specifically may be
> simplified not to use pcase-let:
>
> (if (pcase--trivial-upat-p (car spec))
>       `(dolist ,spec ,@body)
>     (let ((tmpvar (gensym "x")))
>       `(dolist (,tmpvar ,@(cdr spec))
>          (pcase ,tmpvar (,(car spec) ,@body)))))

See the attached patch.
If the patch is acceptable, we also need to update the manual.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-pcase-let-Skip-LIST-element-that-do-not-match-the-PA.patch --]
[-- Type: text/x-patch, Size: 3056 bytes --]

From f3e1362f7687c731e0ba4e410f005252309ffc3f Mon Sep 17 00:00:00 2001
Message-ID: <f3e1362f7687c731e0ba4e410f005252309ffc3f.1708337064.git.yantar92@posteo.net>
From: Ihor Radchenko <yantar92@posteo.net>
Date: Mon, 19 Feb 2024 13:02:21 +0300
Subject: [PATCH] pcase-let: Skip LIST element that do not match the PATTERN
 (bug#68509)

* lisp/emacs-lisp/pcase.el (pcase-dolist): Use `pcase' rather than
`pcase-let*' to match the list elements.  Update the docstring,
describing the behavior when list elements to not match the pattern.
The previous undefined behavior is removed.
* test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-pcase-dolist): Add
new test.
---
 lisp/emacs-lisp/pcase.el            | 13 ++++++-------
 test/lisp/emacs-lisp/pcase-tests.el | 12 ++++++++++++
 2 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index ae9bd87997c..8dc11b20a6f 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -329,21 +329,20 @@ pcase-let
 (defmacro pcase-dolist (spec &rest body)
   "Eval BODY once for each set of bindings defined by PATTERN and LIST elements.
 PATTERN should be a `pcase' pattern describing the structure of
-LIST elements, and LIST is a list of objects that match PATTERN,
-i.e. have a structure that is compatible with PATTERN.
+LIST elements, and LIST is a list of objects.
 For each element of LIST, this macro binds the variables in
 PATTERN to the corresponding subfields of the LIST element, and
-then evaluates BODY with these bindings in effect.  The
-destructuring bindings of variables in PATTERN to the subfields
-of the elements of LIST is performed as if by `pcase-let'.
+then evaluates BODY with these bindings in effect.  When an element does
+not match the pattern, such element is skipped.
+The destructuring bindings of variables in PATTERN to the subfields
+of the elements of LIST is performed as if by `pcase'.
 \n(fn (PATTERN LIST) BODY...)"
   (declare (indent 1) (debug ((pcase-PAT form) body)))
   (if (pcase--trivial-upat-p (car spec))
       `(dolist ,spec ,@body)
     (let ((tmpvar (gensym "x")))
       `(dolist (,tmpvar ,@(cdr spec))
-         (pcase-let* ((,(car spec) ,tmpvar))
-           ,@body)))))
+	 (pcase ,tmpvar (,(car spec) ,@body))))))
 
 ;;;###autoload
 (defmacro pcase-setq (pat val &rest args)
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index d062965952a..241729c108a 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -160,4 +160,16 @@ pcase-tests-setq
   (should-error (pcase-setq a)
                 :type '(wrong-number-of-arguments)))
 
+(ert-deftest pcase-tests-pcase-dolist ()
+  ;; Ignore non-matching elements.
+  (should
+   (equal
+    '(("DONE" . "a"))
+    (let (result)
+      (pcase-dolist (`(,(and (pred stringp) a) .
+		       ,(and (pred stringp) b))
+	             '(("TODO") ("DONE" . "a")))
+        (push (cons a b) result))
+      (nreverse result)))))
+
 ;;; pcase-tests.el ends here.
-- 
2.43.0


[-- Attachment #3: Type: text/plain, Size: 224 bytes --]


-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>