(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"))))
(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"))))
(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"))))
(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"))))))
(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)
"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.
(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"))))))
;; 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.
;; 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)))))))
'("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."
(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)
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
: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
(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)
(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")
;; 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))))
(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)
(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)
(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)
(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)
(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)))))
(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")))))
(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"))))
(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")))))
(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!")))))
;; 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))")))))
(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)
projects / emacs.git / commitdiff