procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Revert "Use advice-flet' in place of cl-letf' to avoid primitive...

Browse source 
This reverts commit 825e85b393.
This commit is contained in:
Andrea Corallo 2020-10-04 20:09:04 +02:00
parent ad5a2bbde0
commit b3ade4de17
12 changed files with 115 additions and 119 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
test/lisp/abbrev-tests.el
View file

@ -279,7 +279,7 @@
(let ((table (make-abbrev-table)))
(with-temp-buffer
(insert "some text foo ")
(advice-flet ((read-string (lambda (&rest _) "bar")))
(cl-letf (((symbol-function '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 ")
(advice-flet ((read-string (lambda (&rest _) "bar")))
(cl-letf (((symbol-function '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))
(advice-flet ((read-string (lambda (&rest _) "bar")))
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "bar")))
(inverse-add-abbrev table "Global" -1)))
(should (string= (abbrev-expansion "text" table) "bar"))))

6
test/lisp/bookmark-tests.el
View file

@ -633,9 +633,9 @@ testing `bookmark-bmenu-list'."
(ert-deftest bookmark-test-bmenu-locate ()
(let (msg)
(advice-flet ((message
(lambda (&rest args)
(setq msg (apply #'format args)))))
(cl-letf (((symbol-function 'message)
(lambda (&rest args)
(setq msg (apply #'format args)))))
(with-bookmark-bmenu-test
(bookmark-bmenu-locate)
(should (equal msg "/some/file"))))))

10
test/lisp/emacs-lisp/rmc-tests.el
View file

@ -33,12 +33,10 @@
(ert-deftest test-read-multiple-choice ()
(dolist (char '(?y ?n))
(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")))))))))
(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"))))))))
(provide 'rmc-tests)

37
test/lisp/files-tests.el
View file

@ -242,25 +242,24 @@ form.")
"Test file prompting in directory named `~'.
If we are in a directory named `~', the default value should not
be $HOME."
(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)))))
(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))))
(ert-deftest files-tests-file-name-non-special-quote-unquote ()
(let (;; Just in case it is quoted, who knows.

56
test/lisp/kmacro-tests.el
View file

@ -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"
(advice-flet ((this-single-command-keys (lambda ()
[?\C-x ?e])))
(cl-letf (((symbol-function #'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))))
(advice-flet ((this-single-command-keys
(lambda () first-event)))
(cl-letf (((symbol-function #'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))))
(advice-flet ((edit-kbd-macro #'ignore)
(this-single-command-keys
(lambda () first-event)))
(cl-letf (((symbol-function #'edit-kbd-macro) #'ignore)
((symbol-function #'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,22 +494,20 @@ 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))
(advice-flet ((this-single-command-keys (lambda ()
first-event)))
;; "Record" some macros.
(dotimes (n 4)
(kmacro-tests-define-macro (make-vector 1 (+ ?a n))))
(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))))))))
(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."
@ -544,18 +542,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.
(advice-flet ((yes-or-no-p
(lambda (prompt)
(should (string-match-p "info" prompt))
(should (string-match-p "C-h i" prompt))
nil)))
(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)))
(kmacro-bind-to-key nil))
(should (equal (where-is-internal 'info nil t)
(vconcat "\C-hi")))
;; Try it again with yes.
(advice-flet ((yes-or-no-p
(lambda (_prompt) t)))
(cl-letf (((symbol-function #' yes-or-no-p)
(lambda (_prompt) t)))
(kmacro-bind-to-key nil))
(should-not (equal (where-is-internal 'info global-map t)

20
test/lisp/net/tramp-tests.el
View file

@ -2420,16 +2420,16 @@ This checks also `file-name-as-directory', `file-name-directory',
tramp--test-messages))))))))
;; Do not overwrite if excluded.
(advice-flet ((y-or-n-p (lambda (_prompt) t))
;; Ange-FTP.
(yes-or-no-p (lambda (_prompt) t)))
(cl-letf (((symbol-function #'y-or-n-p) (lambda (_prompt) t))
;; Ange-FTP.
((symbol-function '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
(advice-flet ((y-or-n-p #'ignore)
;; Ange-FTP.
(yes-or-no-p 'ignore))
(cl-letf (((symbol-function #'y-or-n-p) #'ignore)
;; Ange-FTP.
((symbol-function '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.
(advice-flet ((yes-or-no-p #'ignore))
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
(make-symbolic-link tmp-name1 tmp-name2 0)
:type 'file-already-exists)))
(advice-flet ((yes-or-no-p (lambda (_prompt) t)))
(cl-letf (((symbol-function #'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.
(advice-flet ((yes-or-no-p #'ignore))
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
(add-name-to-file tmp-name1 tmp-name2 0)
:type 'file-already-exists))
(advice-flet ((yes-or-no-p (lambda (_prompt) t)))
(cl-letf (((symbol-function #'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)

4
test/lisp/play/dissociate-tests.el
View file

@ -25,8 +25,8 @@
(require 'dissociate)
(ert-deftest dissociate-tests-dissociated-press ()
(advice-flet ((y-or-n-p (lambda (_) nil))
(random (lambda (_) 10)))
(cl-letf (((symbol-function 'y-or-n-p) (lambda (_) nil))
((symbol-function 'random) (lambda (_) 10)))
(save-window-excursion
(with-temp-buffer
(insert "Lorem ipsum dolor sit amet")

45
test/lisp/replace-tests.el
View file

@ -443,28 +443,29 @@ 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.
(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"))))
(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"))))
(perform-replace ,from ,to t replace-tests-perform-replace-regexp-flag nil))
,@body))))

32
test/lisp/shadowfile-tests.el
View file

@ -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.
(advice-flet ((read-from-minibuffer
(lambda (&rest _args) (pop mocked-input)))
(read-string
(lambda (&rest _args) (pop mocked-input))))
(cl-letf* (((symbol-function #'read-from-minibuffer)
(lambda (&rest _args) (pop mocked-input)))
((symbol-function #'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.
(advice-flet ((read-from-minibuffer
(lambda (&rest _args) (pop mocked-input)))
(read-string
(lambda (&rest _args) (pop mocked-input))))
(cl-letf* (((symbol-function #'read-from-minibuffer)
(lambda (&rest _args) (pop mocked-input)))
((symbol-function #'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.
(advice-flet ((read-from-minibuffer
(lambda (&rest _args) (pop mocked-input)))
(read-string
(lambda (&rest _args) (pop mocked-input))))
(cl-letf* (((symbol-function #'read-from-minibuffer)
(lambda (&rest _args) (pop mocked-input)))
((symbol-function #'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.
(advice-flet ((read-from-minibuffer
(lambda (&rest _args) (pop mocked-input)))
(read-string
(lambda (&rest _args) (pop mocked-input))))
(cl-letf* (((symbol-function #'read-from-minibuffer)
(lambda (&rest _args) (pop mocked-input)))
((symbol-function #'read-string)
(lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)

4
test/lisp/subr-tests.el
View file

@ -337,8 +337,8 @@ cf. Bug#25477."
(ert-deftest subr-tests-bug22027 ()
"Test for https://debbugs.gnu.org/22027 ."
(let ((default "foo") res)
(advice-flet ((read-string
(lambda (_prompt _init _hist def) def)))
(cl-letf (((symbol-function 'read-string)
(lambda (_prompt _init _hist def) def)))
(setq res (read-passwd "pass: " 'confirm (mapconcat #'string default "")))
(should (string= default res)))))

10
test/lisp/tempo-tests.el
View file

@ -55,7 +55,7 @@
(with-temp-buffer
(tempo-define-template "test" '("hello " (p ">")))
(let ((tempo-interactive t))
(advice-flet ((read-string (lambda (&rest _) "world")))
(cl-letf (((symbol-function '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.
(advice-flet ((read-string (lambda (&rest _) "world")))
(cl-letf (((symbol-function '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))
(advice-flet ((read-string (lambda (&rest _) "F")))
(cl-letf (((symbol-function '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))
(advice-flet ((read-string (lambda (&rest _) "world!")))
(cl-letf (((symbol-function '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))
(advice-flet ((read-string (lambda (&rest _) " (list 1 2 3)")))
(cl-letf (((symbol-function '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))")))))

4
test/lisp/time-stamp-tests.el
View file

@ -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))
`(advice-flet ((system-name
(lambda () ,name)))
`(cl-letf (((symbol-function 'system-name)
(lambda () ,name)))
,@body))
(defmacro time-stamp-should-warn (form)