From 825e85b393a3d78ba43176ecc5bc1a9595d0fbea Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 2 Oct 2020 18:38:02 +0200 Subject: [PATCH] Use `advice-flet' in place of `cl-letf' to avoid primitive redefinition * test/lisp/time-stamp-tests.el (with-time-stamp-system-name): Use `advice-flet' to advice primitive avoiding redefinition. * test/lisp/tempo-tests.el (tempo-p-element-test) (tempo-P-element-test, tempo-r-element-test) (tempo-s-element-test, tempo-r>-element-test): Likewise. * test/lisp/subr-tests.el (subr-tests-bug22027): Likewise. * test/lisp/shadowfile-tests.el (shadow-test00-clusters) (shadow-test01-sites, shadow-test06-literal-groups) (shadow-test07-regexp-groups): Likewise. * test/lisp/replace-tests.el (replace-tests-with-undo): Likewise. * test/lisp/play/dissociate-tests.el (dissociate-tests-dissociated-press): Likewise. * test/lisp/net/tramp-tests.el (tramp-test10-write-region) (tramp-test21-file-links): Likewise. * test/lisp/kmacro-tests.el (kmacro-tests-call-macro-hint-and-repeat) (kmacro-tests-repeat-on-last-key) (kmacro-tests-repeat-view-and-run) (kmacro-tests-bind-to-key-with-key-sequence-in-use): Likewise. * test/lisp/files-tests.el (files-tests-read-file-in-~): Likewise. * test/lisp/emacs-lisp/rmc-tests.el (test-read-multiple-choice): Likewise. * test/lisp/bookmark-tests.el (bookmark-test-bmenu-locate): Likewise. * test/lisp/abbrev-tests.el (inverse-add-abbrev-skips-trailing-nonword) (inverse-add-abbrev-skips-trailing-nonword/positive-arg) (inverse-add-abbrev-skips-trailing-nonword/negative-arg): Likewise. --- test/lisp/abbrev-tests.el | 6 ++-- test/lisp/bookmark-tests.el | 6 ++-- test/lisp/emacs-lisp/rmc-tests.el | 10 +++--- test/lisp/files-tests.el | 37 +++++++++---------- test/lisp/kmacro-tests.el | 58 +++++++++++++++--------------- test/lisp/net/tramp-tests.el | 20 +++++------ test/lisp/play/dissociate-tests.el | 4 +-- test/lisp/replace-tests.el | 45 ++++++++++++----------- test/lisp/shadowfile-tests.el | 32 ++++++++--------- test/lisp/subr-tests.el | 4 +-- test/lisp/tempo-tests.el | 10 +++--- test/lisp/time-stamp-tests.el | 4 +-- 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) -- 2.39.5