From 17a3f6bf99382cdf5f982dade86d902ec6427db7 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 22 Mar 2026 16:03:16 +0000 Subject: [PATCH] * lisp/subr.el (member-if): Fix compiler macro multiple evaluation. Problem reported by Pip Cet . --- lisp/subr.el | 9 +++++++-- test/lisp/subr-tests.el | 6 +++++- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index a1d718ca5b7..7a5412d3fb7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1226,8 +1226,13 @@ with (member-if (lambda (x) (foo (bar x))) items)" (declare (compiler-macro (lambda (_) - (let ((x (make-symbol "x"))) - `(drop-while (lambda (,x) (not (funcall ,pred ,x))) ,list))))) + (let* ((x (make-symbol "x")) + (f (and (not (internal--effect-free-fun-arg-p pred)) + (make-symbol "f"))) + (form `(drop-while (lambda (,x) + (not (funcall ,(or f pred) ,x))) + ,list))) + (if f `(let ((,f ,pred)) ,form) form))))) (drop-while (lambda (x) (not (funcall pred x))) list)) ;; This is good to have for improved readability in certain uses, but diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 3d4f524d630..81d44b76606 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1725,7 +1725,11 @@ The argument names are important." (let ((xs (number-sequence 0 4))) (dotimes (x (1+ (length xs))) (should (eq (subr-tests--any-memql x xs) - (memql x xs)))))) + (memql x xs))))) + (let ((n 0)) + (any (prog1 (lambda (x) (eq x 5)) (incf n)) + (number-sequence 0 4)) + (should (eq n 1)))) (ert-deftest total-line-spacing () (progn