summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--test/lisp/abbrev-tests.el6
-rw-r--r--test/lisp/bookmark-tests.el6
-rw-r--r--test/lisp/emacs-lisp/rmc-tests.el10
-rw-r--r--test/lisp/files-tests.el37
-rw-r--r--test/lisp/kmacro-tests.el58
-rw-r--r--test/lisp/net/tramp-tests.el20
-rw-r--r--test/lisp/play/dissociate-tests.el4
-rw-r--r--test/lisp/replace-tests.el45
-rw-r--r--test/lisp/shadowfile-tests.el32
-rw-r--r--test/lisp/subr-tests.el4
-rw-r--r--test/lisp/tempo-tests.el10
-rw-r--r--test/lisp/time-stamp-tests.el4
12 files changed, 120 insertions, 116 deletions
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index aaf1d4a5b5c..9b998add23f 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -279,7 +279,7 @@
(let ((table (make-abbrev-table)))
(with-temp-buffer
(insert "some text foo ")
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "bar")))
+ (advice-flet ((read-string (lambda (&rest _) "bar")))
(inverse-add-abbrev table "Global" 1)))
(should (string= (abbrev-expansion "foo" table) "bar"))))
@@ -288,7 +288,7 @@
(let ((table (make-abbrev-table)))
(with-temp-buffer
(insert "some text foo ")
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "bar")))
+ (advice-flet ((read-string (lambda (&rest _) "bar")))
(inverse-add-abbrev table "Global" 2)))
(should (string= (abbrev-expansion "text" table) "bar"))))
@@ -298,7 +298,7 @@
(with-temp-buffer
(insert "some text foo")
(goto-char (point-min))
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "bar")))
+ (advice-flet ((read-string (lambda (&rest _) "bar")))
(inverse-add-abbrev table "Global" -1)))
(should (string= (abbrev-expansion "text" table) "bar"))))
diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el
index c5959e46d80..26d75ce0c4e 100644
--- a/test/lisp/bookmark-tests.el
+++ b/test/lisp/bookmark-tests.el
@@ -633,9 +633,9 @@ testing `bookmark-bmenu-list'."
(ert-deftest bookmark-test-bmenu-locate ()
(let (msg)
- (cl-letf (((symbol-function 'message)
- (lambda (&rest args)
- (setq msg (apply #'format args)))))
+ (advice-flet ((message
+ (lambda (&rest args)
+ (setq msg (apply #'format args)))))
(with-bookmark-bmenu-test
(bookmark-bmenu-locate)
(should (equal msg "/some/file"))))))
diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el
index 5add24c479a..de6db13347b 100644
--- a/test/lisp/emacs-lisp/rmc-tests.el
+++ b/test/lisp/emacs-lisp/rmc-tests.el
@@ -33,10 +33,12 @@
(ert-deftest test-read-multiple-choice ()
(dolist (char '(?y ?n))
- (cl-letf* (((symbol-function #'read-event) (lambda () char))
- (str (if (eq char ?y) "yes" "no")))
- (should (equal (list char str)
- (read-multiple-choice "Do it? " '((?y "yes") (?n "no"))))))))
+ (let ((str (if (eq char ?y) "yes" "no")))
+ (advice-flet ((read-event
+ (lambda () char)))
+ (should (equal (list char str)
+ (read-multiple-choice "Do it? "
+ '((?y "yes") (?n "no")))))))))
(provide 'rmc-tests)
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 54801adda63..2e9c6adc947 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -242,24 +242,25 @@ form.")
"Test file prompting in directory named `~'.
If we are in a directory named `~', the default value should not
be $HOME."
- (cl-letf (((symbol-function 'completing-read)
- (lambda (_prompt _coll &optional _pred _req init _hist def _)
- (or def init)))
- (dir (make-temp-file "read-file-name-test" t)))
- (unwind-protect
- (let ((subdir (expand-file-name "./~/" dir)))
- (make-directory subdir t)
- (with-temp-buffer
- (setq default-directory subdir)
- (should-not (equal
- (expand-file-name (read-file-name "File: "))
- (expand-file-name "~/")))
- ;; Don't overquote either!
- (setq default-directory (concat "/:" subdir))
- (should-not (equal
- (expand-file-name (read-file-name "File: "))
- (concat "/:/:" subdir)))))
- (delete-directory dir 'recursive))))
+ (let* ((dir (make-temp-file "read-file-name-test" t))
+ (subdir (expand-file-name "./~/" dir)))
+ (advice-flet ((completing-read
+ (lambda (_prompt _coll &optional _pred _req init _hist def _)
+ (or def init))))
+ (unwind-protect
+ (progn
+ (make-directory subdir t)
+ (with-temp-buffer
+ (setq default-directory subdir)
+ (should-not (equal
+ (expand-file-name (read-file-name "File: "))
+ (expand-file-name "~/")))
+ ;; Don't overquote either!
+ (setq default-directory (concat "/:" subdir))
+ (should-not (equal
+ (expand-file-name (read-file-name "File: "))
+ (concat "/:/:" subdir)))))
+ (delete-directory dir 'recursive)))))
(ert-deftest files-tests-file-name-non-special-quote-unquote ()
(let (;; Just in case it is quoted, who knows.
diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el
index bb18c828140..cc0f48eee8f 100644
--- a/test/lisp/kmacro-tests.el
+++ b/test/lisp/kmacro-tests.el
@@ -341,8 +341,8 @@ This is a regression test for: Bug#3412, Bug#11817."
(message "") ; Clear the echo area. (Bug#3412)
(kmacro-tests-should-match-message "Type e to repeat macro"
(kmacro-tests-should-insert "mmmmmm"
- (cl-letf (((symbol-function #'this-single-command-keys) (lambda ()
- [?\C-x ?e])))
+ (advice-flet ((this-single-command-keys (lambda ()
+ [?\C-x ?e])))
(kmacro-call-macro 3))
;; Check that it set up for repeat, and run the repeat.
(funcall (lookup-key overriding-terminal-local-map "e"))))))
@@ -455,8 +455,8 @@ This is a regression test for: Bug#3412, Bug#11817."
;; commands so it should end the sequence.
(let* ((end-key (kmacro-tests-get-kmacro-key 'kmacro-set-counter))
(kmacro-tests-events (append events (list end-key))))
- (cl-letf (((symbol-function #'this-single-command-keys)
- (lambda () first-event)))
+ (advice-flet ((this-single-command-keys
+ (lambda () first-event)))
(use-local-map kmacro-tests-keymap)
(kmacro-tests-should-insert "ccbacb"
;; End #3 and launch loop to read events.
@@ -466,9 +466,9 @@ This is a regression test for: Bug#3412, Bug#11817."
;; so run it again with that at the end.
(let* ((end-key (kmacro-tests-get-kmacro-key 'kmacro-edit-macro-repeat))
(kmacro-tests-events (append events (list end-key))))
- (cl-letf (((symbol-function #'edit-kbd-macro) #'ignore)
- ((symbol-function #'this-single-command-keys)
- (lambda () first-event)))
+ (advice-flet ((edit-kbd-macro #'ignore)
+ (this-single-command-keys
+ (lambda () first-event)))
(use-local-map kmacro-tests-keymap)
(kmacro-tests-should-insert "bbbbbaaba"
(kmacro-end-or-call-macro-repeat 3)))))))
@@ -494,20 +494,22 @@ This is a regression test for: Bug#3412, Bug#11817."
'("d" "c" "b" "a" "d" "c")))))
(cl-letf ((kmacro-repeat-no-prefix t)
(kmacro-call-repeat-key t)
- (kmacro-call-repeat-with-arg nil)
- ((symbol-function #'this-single-command-keys) (lambda ()
- first-event)))
- ;; "Record" some macros.
- (dotimes (n 4)
- (kmacro-tests-define-macro (make-vector 1 (+ ?a n))))
-
- (use-local-map kmacro-tests-keymap)
- ;; 6 views (the direct call plus the 5 in events) should
- ;; cycle through the ring and get to the second-to-last
- ;; macro defined.
- (kmacro-tests-should-insert "c"
- (kmacro-tests-should-match-message macros-regexp
- (kmacro-tests-simulate-command '(kmacro-view-macro-repeat nil)))))))
+ (kmacro-call-repeat-with-arg nil))
+ (advice-flet ((this-single-command-keys (lambda ()
+ first-event)))
+ ;; "Record" some macros.
+ (dotimes (n 4)
+ (kmacro-tests-define-macro (make-vector 1 (+ ?a n))))
+
+ (use-local-map kmacro-tests-keymap)
+ ;; 6 views (the direct call plus the 5 in events) should
+ ;; cycle through the ring and get to the second-to-last
+ ;; macro defined.
+ (kmacro-tests-should-insert
+ "c"
+ (kmacro-tests-should-match-message
+ macros-regexp
+ (kmacro-tests-simulate-command '(kmacro-view-macro-repeat nil))))))))
(kmacro-tests-deftest kmacro-tests-bind-to-key-when-recording ()
"Bind to key doesn't bind a key during macro recording."
@@ -542,18 +544,18 @@ This is a regression test for: Bug#3412, Bug#11817."
(define-key map "\C-hi" 'info)
(use-local-map map)
;; Try the command with yes-or-no-p set up to say no.
- (cl-letf (((symbol-function #'yes-or-no-p)
- (lambda (prompt)
- (should (string-match-p "info" prompt))
- (should (string-match-p "C-h i" prompt))
- nil)))
+ (advice-flet ((yes-or-no-p
+ (lambda (prompt)
+ (should (string-match-p "info" prompt))
+ (should (string-match-p "C-h i" prompt))
+ nil)))
(kmacro-bind-to-key nil))
(should (equal (where-is-internal 'info nil t)
(vconcat "\C-hi")))
;; Try it again with yes.
- (cl-letf (((symbol-function #' yes-or-no-p)
- (lambda (_prompt) t)))
+ (advice-flet ((yes-or-no-p
+ (lambda (_prompt) t)))
(kmacro-bind-to-key nil))
(should-not (equal (where-is-internal 'info global-map t)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 3914f9ae44e..0e4fcb5951f 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2420,16 +2420,16 @@ This checks also `file-name-as-directory', `file-name-directory',
tramp--test-messages))))))))
;; Do not overwrite if excluded.
- (cl-letf (((symbol-function #'y-or-n-p) (lambda (_prompt) t))
- ;; Ange-FTP.
- ((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
+ (advice-flet ((y-or-n-p (lambda (_prompt) t))
+ ;; Ange-FTP.
+ (yes-or-no-p (lambda (_prompt) t)))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
;; `mustbenew' is passed to Tramp since Emacs 26.1.
(when (tramp--test-emacs26-p)
(should-error
- (cl-letf (((symbol-function #'y-or-n-p) #'ignore)
- ;; Ange-FTP.
- ((symbol-function 'yes-or-no-p) 'ignore))
+ (advice-flet ((y-or-n-p #'ignore)
+ ;; Ange-FTP.
+ (yes-or-no-p 'ignore))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
:type 'file-already-exists)
(should-error
@@ -3522,11 +3522,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
:type 'file-already-exists))
(when (tramp--test-expensive-test)
;; A number means interactive case.
- (cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
+ (advice-flet ((yes-or-no-p #'ignore))
(should-error
(make-symbolic-link tmp-name1 tmp-name2 0)
:type 'file-already-exists)))
- (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t)))
+ (advice-flet ((yes-or-no-p (lambda (_prompt) t)))
(make-symbolic-link tmp-name1 tmp-name2 0)
(should
(string-equal
@@ -3598,11 +3598,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(add-name-to-file tmp-name1 tmp-name2)
:type 'file-already-exists)
;; A number means interactive case.
- (cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
+ (advice-flet ((yes-or-no-p #'ignore))
(should-error
(add-name-to-file tmp-name1 tmp-name2 0)
:type 'file-already-exists))
- (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t)))
+ (advice-flet ((yes-or-no-p (lambda (_prompt) t)))
(add-name-to-file tmp-name1 tmp-name2 0)
(should (file-regular-p tmp-name2)))
(add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
diff --git a/test/lisp/play/dissociate-tests.el b/test/lisp/play/dissociate-tests.el
index e8d903109fc..1583a51acd5 100644
--- a/test/lisp/play/dissociate-tests.el
+++ b/test/lisp/play/dissociate-tests.el
@@ -25,8 +25,8 @@
(require 'dissociate)
(ert-deftest dissociate-tests-dissociated-press ()
- (cl-letf (((symbol-function 'y-or-n-p) (lambda (_) nil))
- ((symbol-function 'random) (lambda (_) 10)))
+ (advice-flet ((y-or-n-p (lambda (_) nil))
+ (random (lambda (_) 10)))
(save-window-excursion
(with-temp-buffer
(insert "Lorem ipsum dolor sit amet")
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index aed14c33572..0f8084704d9 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -443,29 +443,28 @@ Return the last evalled form in BODY."
;; Bind `read-event' to simulate user input.
;; If `replace-tests-bind-read-string' is non-nil, then
;; bind `read-string' as well.
- (cl-letf (((symbol-function 'read-event)
- (lambda (&rest _args)
- (cl-incf ,count)
- (pcase ,count ; Build the clauses from CHAR-NUMS
- ,@(append
- (delq nil
- (mapcar
- (lambda (chr)
- (when-let (it (alist-get chr char-nums))
- (if (cdr it)
- `(,(cons 'or it) ,chr)
- `(,(car it) ,chr))))
- '(?, ?\s ?u ?U ?E ?q)))
- `((_ ,def-chr))))))
- ((symbol-function 'read-string)
- (if replace-tests-bind-read-string
- (lambda (&rest _args) replace-tests-bind-read-string)
- (symbol-function 'read-string)))
- ;; Emulate replace-highlight clobbering match-data via
- ;; isearch-lazy-highlight-new-loop and sit-for (bug#36328)
- ((symbol-function 'replace-highlight)
- (lambda (&rest _args)
- (string-match "[A-Z ]" "ForestGreen"))))
+ (advice-flet ((read-event
+ (lambda (&rest _args)
+ (cl-incf ,count)
+ (pcase ,count ; Build the clauses from CHAR-NUMS
+ ,@(append
+ (delq nil
+ (mapcar
+ (lambda (chr)
+ (when-let (it (alist-get chr char-nums))
+ (if (cdr it)
+ `(,(cons 'or it) ,chr)
+ `(,(car it) ,chr))))
+ '(?, ?\s ?u ?U ?E ?q)))
+ `((_ ,def-chr))))))
+ (read-string
+ (if replace-tests-bind-read-string
+ (lambda (&rest _args) replace-tests-bind-read-string)
+ (lambda (&rest args)
+ (apply #'read-string args))))
+ (replace-highlight
+ (lambda (&rest _args)
+ (string-match "[A-Z ]" "ForestGreen"))))
(perform-replace ,from ,to t replace-tests-perform-replace-regexp-flag nil))
,@body))))
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index f40f6a1cdb0..6a9664638fa 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -138,10 +138,10 @@ guaranteed by the originator of a cluster definition."
(unwind-protect
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
- (cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest _args) (pop mocked-input)))
- ((symbol-function #'read-string)
- (lambda (&rest _args) (pop mocked-input))))
+ (advice-flet ((read-from-minibuffer
+ (lambda (&rest _args) (pop mocked-input)))
+ (read-string
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -255,10 +255,10 @@ guaranteed by the originator of a cluster definition."
(unwind-protect
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
- (cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest _args) (pop mocked-input)))
- ((symbol-function #'read-string)
- (lambda (&rest _args) (pop mocked-input))))
+ (advice-flet ((read-from-minibuffer
+ (lambda (&rest _args) (pop mocked-input)))
+ (read-string
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -608,10 +608,10 @@ guaranteed by the originator of a cluster definition."
(unwind-protect
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
- (cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest _args) (pop mocked-input)))
- ((symbol-function #'read-string)
- (lambda (&rest _args) (pop mocked-input))))
+ (advice-flet ((read-from-minibuffer
+ (lambda (&rest _args) (pop mocked-input)))
+ (read-string
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -669,10 +669,10 @@ guaranteed by the originator of a cluster definition."
(unwind-protect
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
- (cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest _args) (pop mocked-input)))
- ((symbol-function #'read-string)
- (lambda (&rest _args) (pop mocked-input))))
+ (advice-flet ((read-from-minibuffer
+ (lambda (&rest _args) (pop mocked-input)))
+ (read-string
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 035c064d75c..b131b509355 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -337,8 +337,8 @@ cf. Bug#25477."
(ert-deftest subr-tests-bug22027 ()
"Test for https://debbugs.gnu.org/22027 ."
(let ((default "foo") res)
- (cl-letf (((symbol-function 'read-string)
- (lambda (_prompt _init _hist def) def)))
+ (advice-flet ((read-string
+ (lambda (_prompt _init _hist def) def)))
(setq res (read-passwd "pass: " 'confirm (mapconcat #'string default "")))
(should (string= default res)))))
diff --git a/test/lisp/tempo-tests.el b/test/lisp/tempo-tests.el
index bfe475910da..333abffc84f 100644
--- a/test/lisp/tempo-tests.el
+++ b/test/lisp/tempo-tests.el
@@ -55,7 +55,7 @@
(with-temp-buffer
(tempo-define-template "test" '("hello " (p ">")))
(let ((tempo-interactive t))
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "world")))
+ (advice-flet ((read-string (lambda (&rest _) "world")))
(tempo-insert-template 'tempo-template-test nil))
(should (equal (buffer-string) "hello world")))))
@@ -64,7 +64,7 @@
(with-temp-buffer
(tempo-define-template "test" '("hello " (P ">")))
;; By default, `tempo-interactive' is nil, `P' should ignore this.
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "world")))
+ (advice-flet ((read-string (lambda (&rest _) "world")))
(tempo-insert-template 'tempo-template-test nil))
(should (equal (buffer-string) "hello world"))))
@@ -73,7 +73,7 @@
(with-temp-buffer
(tempo-define-template "test" '("abcde" (r ">") "ghijk"))
(let ((tempo-interactive t))
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "F")))
+ (advice-flet ((read-string (lambda (&rest _) "F")))
(tempo-insert-template 'tempo-template-test nil))
(should (equal (buffer-string) "abcdeFghijk")))))
@@ -82,7 +82,7 @@
(with-temp-buffer
(tempo-define-template "test" '("hello " (p ">" P1) " " (s P1)))
(let ((tempo-interactive t))
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "world!")))
+ (advice-flet ((read-string (lambda (&rest _) "world!")))
(tempo-insert-template 'tempo-template-test nil))
(should (equal (buffer-string) "hello world! world!")))))
@@ -164,7 +164,7 @@
;; Test interactive use
(emacs-lisp-mode)
(let ((tempo-interactive t))
- (cl-letf (((symbol-function 'read-string) (lambda (&rest _) " (list 1 2 3)")))
+ (advice-flet ((read-string (lambda (&rest _) " (list 1 2 3)")))
(tempo-insert-template 'tempo-template-test nil))
(should (equal (buffer-string) "(progn\n (list 1 2 3))")))))
diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el
index e75e84b0221..ab662ffd959 100644
--- a/test/lisp/time-stamp-tests.el
+++ b/test/lisp/time-stamp-tests.el
@@ -57,8 +57,8 @@
(defmacro with-time-stamp-system-name (name &rest body)
"Force (system-name) to return NAME while evaluating BODY."
(declare (indent defun))
- `(cl-letf (((symbol-function 'system-name)
- (lambda () ,name)))
+ `(advice-flet ((system-name
+ (lambda () ,name)))
,@body))
(defmacro time-stamp-should-warn (form)
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-08 15:48:53 +0000