bug#57502: 29.0.50; Issue with `or' clause of buffer-match-p

[Philip Kaludercic <philipk@posteo.net>]

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

Philip Kaludercic <philipk@posteo.net> writes:

> Augusto Stoffel <arstoffel@gmail.com> writes:
>
>> This buffer-match-p condition does the expected job:
>>
>>      (buffer-match-p '(or "\\*" (derived-mode . special-mode))
>>                      (current-buffer))
>>
>> But this presumably equivalent one gives a “(wrong-type-argument listp
>> special-mode)” error:
>>
>>      (buffer-match-p '(or (and "\\*")
>>                           (derived-mode . special-mode))
>>                      (current-buffer))
>
> It seems to me that the issue is related to the `and' being wrapped by
> an `or', specifically because of a typo in the handling of `and':
>
> diff --git a/lisp/subr.el b/lisp/subr.el
> index 2ffc594997..0350c16ccf 100644
> --- a/lisp/subr.el
> +++ b/lisp/subr.el
> @@ -7014,8 +7014,8 @@ buffer-match-p
>                        (funcall match (cdr condition)))
>                       ((eq (car-safe condition) 'and)
>                        (catch 'fail
> -                        (dolist (c (cdr conditions))
> -                          (unless (funcall match c)
> +                        (dolist (c (cdr condition))
> +                          (unless (funcall match (list c))
>                              (throw 'fail nil)))
>                          t)))
>                  (throw 'match t)))))))
>
>
> As you have pointed out to me privately, it might make sense to rewrite
> the case distinction using pcase, to avoid simple mistakes like these.

That might look something like this:


[-- Attachment #2: Type: text/plain, Size: 2849 bytes --]

diff --git a/lisp/subr.el b/lisp/subr.el
index 2ffc594997..db1dc25044 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6992,32 +6992,32 @@ buffer-match-p
         (lambda (conditions)
           (catch 'match
             (dolist (condition conditions)
-              (when (cond
-                     ((eq condition t))
-                     ((stringp condition)
-                      (string-match-p condition (buffer-name buffer)))
-                     ((functionp condition)
-                      (if (eq 1 (cdr (func-arity condition)))
-                          (funcall condition buffer)
-                        (funcall condition buffer arg)))
-                     ((eq (car-safe condition) 'major-mode)
-                      (eq
-                       (buffer-local-value 'major-mode buffer)
-                       (cdr condition)))
-                     ((eq (car-safe condition) 'derived-mode)
-                      (provided-mode-derived-p
-                       (buffer-local-value 'major-mode buffer)
-                       (cdr condition)))
-                     ((eq (car-safe condition) 'not)
-                      (not (funcall match (cdr condition))))
-                     ((eq (car-safe condition) 'or)
-                      (funcall match (cdr condition)))
-                     ((eq (car-safe condition) 'and)
-                      (catch 'fail
-                        (dolist (c (cdr conditions))
-                          (unless (funcall match c)
-                            (throw 'fail nil)))
-                        t)))
+              (when (pcase condition
+                      ('t t)
+                      ((pred stringp)
+                       (string-match-p condition (buffer-name buffer)))
+                      ((pred functionp)
+                       (if (eq 1 (cdr (func-arity condition)))
+                           (funcall condition buffer)
+                         (funcall condition buffer arg)))
+                      (`(major-mode . ,mode)
+                       (eq
+                        (buffer-local-value 'major-mode buffer)
+                        mode))
+                      (`(derived-mode . ,mode)
+                       (provided-mode-derived-p
+                        (buffer-local-value 'major-mode buffer)
+                        mode))
+                      (`(not . cond)
+                       (not (funcall match cond)))
+                      (`(or . ,args)
+                       (funcall match args))
+                      (`(and . ,args)
+                       (catch 'fail
+                         (dolist (c args)
+                           (unless (funcall match (list c))
+                             (throw 'fail nil)))
+                         t)))
                 (throw 'match t)))))))
     (funcall match (list condition))))