From 19dc72069c79865d5464737b4ce10ed25a3be49b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 12:24:12 -0500 Subject: Use cl-lib instead of cl, and interactive-p => called-interactively-p. * lisp/erc/erc-track.el, lisp/erc/erc-networks.el, lisp/erc/erc-netsplit.el: * lisp/erc/erc-dcc.el, lisp/erc/erc-backend.el: Use cl-lib, nth, pcase, and called-interactively-p instead of cl. * lisp/erc/erc-speedbar.el, lisp/erc/erc-services.el: * lisp/erc/erc-pcomplete.el, lisp/erc/erc-notify.el, lisp/erc/erc-match.el: * lisp/erc/erc-log.el, lisp/erc/erc-join.el, lisp/erc/erc-ezbounce.el: * lisp/erc/erc-capab.el: Don't require cl since we don't use it. * lisp/erc/erc.el: Use cl-lib, nth, pcase, and called-interactively-p i.s.o cl. (erc-lurker-ignore-chars, erc-common-server-suffixes): Move before first use. * lisp/json.el: Don't require cl since we don't use it. * lisp/color.el: Don't require cl. (color-complement): `caddr' -> `nth 2'. * test/automated/ert-x-tests.el: Use cl-lib. * test/automated/ert-tests.el: Use lexical-binding and cl-lib. --- test/ChangeLog | 9 ++- test/automated/ert-tests.el | 132 +++++++++++++++++++++--------------------- test/automated/ert-x-tests.el | 50 ++++++++-------- 3 files changed, 99 insertions(+), 92 deletions(-) (limited to 'test') diff --git a/test/ChangeLog b/test/ChangeLog index f11325d0318..75903ae3ef4 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,8 @@ +2012-11-19 Stefan Monnier + + * automated/ert-x-tests.el: Use cl-lib. + * automated/ert-tests.el: Use lexical-binding and cl-lib. + 2012-11-14 Dmitry Gutov * automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass. @@ -5,8 +10,8 @@ (ruby-indent-inside-heredoc-after-space): New tests. Change direct font-lock face references to var references. (ruby-interpolation-suppresses-syntax-inside): New test. - (ruby-interpolation-inside-percent-literal-with-paren): New - failing test. + (ruby-interpolation-inside-percent-literal-with-paren): + New failing test. 2012-11-13 Dmitry Gutov diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el index 1778afea802..1aef1921871 100644 --- a/test/automated/ert-tests.el +++ b/test/automated/ert-tests.el @@ -1,4 +1,4 @@ -;;; ert-tests.el --- ERT's self-tests +;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*- ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. @@ -27,7 +27,7 @@ ;;; Code: (eval-when-compile - (require 'cl)) + (require 'cl-lib)) (require 'ert) @@ -45,7 +45,7 @@ ;; The buffer name chosen here should not compete with the default ;; results buffer name for completion in `switch-to-buffer'. (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*"))) - (assert ert--test-body-was-run) + (cl-assert ert--test-body-was-run) (if (zerop (ert-stats-completed-unexpected stats)) ;; Hide results window only when everything went well. (set-window-configuration window-configuration) @@ -71,26 +71,26 @@ failed or if there was a problem." (ert-deftest ert-test-nested-test-body-runs () "Test that nested test bodies run." - (lexical-let ((was-run nil)) + (let ((was-run nil)) (let ((test (make-ert-test :body (lambda () (setq was-run t))))) - (assert (not was-run)) + (cl-assert (not was-run)) (ert-run-test test) - (assert was-run)))) + (cl-assert was-run)))) ;;; Test that pass/fail works. (ert-deftest ert-test-pass () (let ((test (make-ert-test :body (lambda ())))) (let ((result (ert-run-test test))) - (assert (ert-test-passed-p result))))) + (cl-assert (ert-test-passed-p result))))) (ert-deftest ert-test-fail () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) - (assert (ert-test-failed-p result) t) - (assert (equal (ert-test-result-with-condition-condition result) + (cl-assert (ert-test-failed-p result) t) + (cl-assert (equal (ert-test-result-with-condition-condition result) '(ert-test-failed "failure message")) t)))) @@ -100,50 +100,50 @@ failed or if there was a problem." (progn (let ((ert-debug-on-error t)) (ert-run-test test)) - (assert nil)) + (cl-assert nil)) ((error) - (assert (equal condition '(ert-test-failed "failure message")) t))))) + (cl-assert (equal condition '(ert-test-failed "failure message")) t))))) (ert-deftest ert-test-fail-debug-with-debugger-1 () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (let ((debugger (lambda (&rest debugger-args) - (assert nil)))) + (let ((debugger (lambda (&rest _args) + (cl-assert nil)))) (let ((ert-debug-on-error nil)) (ert-run-test test))))) (ert-deftest ert-test-fail-debug-with-debugger-2 () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (block nil - (let ((debugger (lambda (&rest debugger-args) - (return-from nil nil)))) + (cl-block nil + (let ((debugger (lambda (&rest _args) + (cl-return-from nil nil)))) (let ((ert-debug-on-error t)) (ert-run-test test)) - (assert nil))))) + (cl-assert nil))))) (ert-deftest ert-test-fail-debug-nested-with-debugger () (let ((test (make-ert-test :body (lambda () (let ((ert-debug-on-error t)) (ert-fail "failure message")))))) - (let ((debugger (lambda (&rest debugger-args) - (assert nil nil "Assertion a")))) + (let ((debugger (lambda (&rest _args) + (cl-assert nil nil "Assertion a")))) (let ((ert-debug-on-error nil)) (ert-run-test test)))) (let ((test (make-ert-test :body (lambda () (let ((ert-debug-on-error nil)) (ert-fail "failure message")))))) - (block nil - (let ((debugger (lambda (&rest debugger-args) - (return-from nil nil)))) + (cl-block nil + (let ((debugger (lambda (&rest _args) + (cl-return-from nil nil)))) (let ((ert-debug-on-error t)) (ert-run-test test)) - (assert nil nil "Assertion b"))))) + (cl-assert nil nil "Assertion b"))))) (ert-deftest ert-test-error () (let ((test (make-ert-test :body (lambda () (error "Error message"))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) - (assert (ert-test-failed-p result) t) - (assert (equal (ert-test-result-with-condition-condition result) + (cl-assert (ert-test-failed-p result) t) + (cl-assert (equal (ert-test-result-with-condition-condition result) '(error "Error message")) t)))) @@ -153,9 +153,9 @@ failed or if there was a problem." (progn (let ((ert-debug-on-error t)) (ert-run-test test)) - (assert nil)) + (cl-assert nil)) ((error) - (assert (equal condition '(error "Error message")) t))))) + (cl-assert (equal condition '(error "Error message")) t))))) ;;; Test that `should' works. @@ -163,13 +163,13 @@ failed or if there was a problem." (let ((test (make-ert-test :body (lambda () (should nil))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) - (assert (ert-test-failed-p result) t) - (assert (equal (ert-test-result-with-condition-condition result) + (cl-assert (ert-test-failed-p result) t) + (cl-assert (equal (ert-test-result-with-condition-condition result) '(ert-test-failed ((should nil) :form nil :value nil))) t))) (let ((test (make-ert-test :body (lambda () (should t))))) (let ((result (ert-run-test test))) - (assert (ert-test-passed-p result) t)))) + (cl-assert (ert-test-passed-p result) t)))) (ert-deftest ert-test-should-value () (should (eql (should 'foo) 'foo)) @@ -179,17 +179,18 @@ failed or if there was a problem." (let ((test (make-ert-test :body (lambda () (should-not t))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) - (assert (ert-test-failed-p result) t) - (assert (equal (ert-test-result-with-condition-condition result) + (cl-assert (ert-test-failed-p result) t) + (cl-assert (equal (ert-test-result-with-condition-condition result) '(ert-test-failed ((should-not t) :form t :value t))) t))) (let ((test (make-ert-test :body (lambda () (should-not nil))))) (let ((result (ert-run-test test))) - (assert (ert-test-passed-p result))))) + (cl-assert (ert-test-passed-p result))))) + (ert-deftest ert-test-should-with-macrolet () (let ((test (make-ert-test :body (lambda () - (macrolet ((foo () `(progn t nil))) + (cl-macrolet ((foo () `(progn t nil))) (should (foo))))))) (let ((result (let ((ert-debug-on-error nil)) (ert-run-test test)))) @@ -303,32 +304,33 @@ This macro is used to test if macroexpansion in `should' works." (ert-deftest ert-test-should-failure-debugging () "Test that `should' errors contain the information we expect them to." - (loop for (body expected-condition) in - `((,(lambda () (let ((x nil)) (should x))) - (ert-test-failed ((should x) :form x :value nil))) - (,(lambda () (let ((x t)) (should-not x))) - (ert-test-failed ((should-not x) :form x :value t))) - (,(lambda () (let ((x t)) (should (not x)))) - (ert-test-failed ((should (not x)) :form (not t) :value nil))) - (,(lambda () (let ((x nil)) (should-not (not x)))) - (ert-test-failed ((should-not (not x)) :form (not nil) :value t))) - (,(lambda () (let ((x t) (y nil)) (should-not - (ert--test-my-list x y)))) - (ert-test-failed - ((should-not (ert--test-my-list x y)) - :form (list t nil) - :value (t nil)))) - (,(lambda () (let ((x t)) (should (error "Foo")))) - (error "Foo"))) - do - (let ((test (make-ert-test :body body))) - (condition-case actual-condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (assert nil)) - ((error) - (should (equal actual-condition expected-condition))))))) + (cl-loop + for (body expected-condition) in + `((,(lambda () (let ((x nil)) (should x))) + (ert-test-failed ((should x) :form x :value nil))) + (,(lambda () (let ((x t)) (should-not x))) + (ert-test-failed ((should-not x) :form x :value t))) + (,(lambda () (let ((x t)) (should (not x)))) + (ert-test-failed ((should (not x)) :form (not t) :value nil))) + (,(lambda () (let ((x nil)) (should-not (not x)))) + (ert-test-failed ((should-not (not x)) :form (not nil) :value t))) + (,(lambda () (let ((x t) (y nil)) (should-not + (ert--test-my-list x y)))) + (ert-test-failed + ((should-not (ert--test-my-list x y)) + :form (list t nil) + :value (t nil)))) + (,(lambda () (let ((_x t)) (should (error "Foo")))) + (error "Foo"))) + do + (let ((test (make-ert-test :body body))) + (condition-case actual-condition + (progn + (let ((ert-debug-on-error t)) + (ert-run-test test)) + (cl-assert nil)) + ((error) + (should (equal actual-condition expected-condition))))))) (ert-deftest ert-test-deftest () (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar))) @@ -520,7 +522,7 @@ This macro is used to test if macroexpansion in `should' works." (setf (cdr (last a)) (cddr a)) (should (not (ert--proper-list-p a)))) (let ((a (list 1 2 3 4))) - (setf (cdr (last a)) (cdddr a)) + (setf (cdr (last a)) (cl-cdddr a)) (should (not (ert--proper-list-p a))))) (ert-deftest ert-test-parse-keys-and-body () @@ -657,14 +659,14 @@ This macro is used to test if macroexpansion in `should' works." (i 0)) (let ((result (ert--remove-if-not (lambda (x) (should (eql x (nth i list))) - (incf i) + (cl-incf i) (member i '(2 3))) list))) (should (equal i 4)) (should (equal result '(b c))) (should (equal list '(a b c d))))) (should (equal '() - (ert--remove-if-not (lambda (x) (should nil)) '())))) + (ert--remove-if-not (lambda (_x) (should nil)) '())))) (ert-deftest ert-test-remove* () (let ((list (list 'a 'b 'c 'd)) @@ -676,13 +678,13 @@ This macro is used to test if macroexpansion in `should' works." (should (eql x (nth key-index list))) (prog1 (list key-index x) - (incf key-index))) + (cl-incf key-index))) :test (lambda (a b) (should (eql a 'foo)) (should (equal b (list test-index (nth test-index list)))) - (incf test-index) + (cl-incf test-index) (member test-index '(2 3)))))) (should (equal key-index 4)) (should (equal test-index 4)) diff --git a/test/automated/ert-x-tests.el b/test/automated/ert-x-tests.el index 520502bb307..e03c8475442 100644 --- a/test/automated/ert-x-tests.el +++ b/test/automated/ert-x-tests.el @@ -28,7 +28,7 @@ ;;; Code: (eval-when-compile - (require 'cl)) + (require 'cl-lib)) (require 'ert) (require 'ert-x) @@ -233,8 +233,8 @@ desired effect." (should (equal (buffer-string) "")) (let ((message-log-max 2)) (let ((message-log-max t)) - (loop for i below 4 do - (message "%s" i)) + (cl-loop for i below 4 do + (message "%s" i)) (should (equal (buffer-string) "0\n1\n2\n3\n"))) (should (equal (buffer-string) "0\n1\n2\n3\n")) (message "") @@ -244,28 +244,28 @@ desired effect." (ert-deftest ert-test-force-message-log-buffer-truncation () :tags '(:causes-redisplay) - (labels ((body () - (loop for i below 3 do - (message "%s" i))) - ;; Uses the implicit messages buffer truncation implemented - ;; in Emacs' C core. - (c (x) - (ert-with-buffer-renamed ("*Messages*") - (let ((message-log-max x)) - (body)) - (with-current-buffer "*Messages*" - (buffer-string)))) - ;; Uses our lisp reimplementation. - (lisp (x) - (ert-with-buffer-renamed ("*Messages*") - (let ((message-log-max t)) - (body)) - (let ((message-log-max x)) - (ert--force-message-log-buffer-truncation)) - (with-current-buffer "*Messages*" - (buffer-string))))) - (loop for x in '(0 1 2 3 4 t) do - (should (equal (c x) (lisp x)))))) + (cl-labels ((body () + (cl-loop for i below 3 do + (message "%s" i))) + ;; Uses the implicit messages buffer truncation implemented + ;; in Emacs' C core. + (c (x) + (ert-with-buffer-renamed ("*Messages*") + (let ((message-log-max x)) + (body)) + (with-current-buffer "*Messages*" + (buffer-string)))) + ;; Uses our lisp reimplementation. + (lisp (x) + (ert-with-buffer-renamed ("*Messages*") + (let ((message-log-max t)) + (body)) + (let ((message-log-max x)) + (ert--force-message-log-buffer-truncation)) + (with-current-buffer "*Messages*" + (buffer-string))))) + (cl-loop for x in '(0 1 2 3 4 t) do + (should (equal (c x) (lisp x)))))) (provide 'ert-x-tests) -- cgit v1.2.1 From 23ba2705e22b89154ef7cbb0595419732080b94c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Nov 2012 23:24:09 -0500 Subject: Make called-interactively-p work for edebug or advised code. * lisp/subr.el (called-interactively-p-functions): New var. (internal--called-interactively-p--get-frame): New macro. (called-interactively-p, interactive-p): Rewrite in Lisp. * lisp/emacs-lisp/nadvice.el (advice--called-interactively-skip): New fun. (called-interactively-p-functions): Use it. * lisp/emacs-lisp/edebug.el (edebug--called-interactively-skip): New fun. (called-interactively-p-functions): Use it. * lisp/allout.el (allout-called-interactively-p): Don't assume called-interactively-p is a subr. * src/eval.c (Finteractive_p, Fcalled_interactively_p, interactive_p): Remove. (syms_of_eval): Remove corresponding defsubr. * src/bytecode.c (exec_byte_code): `interactive-p' is now a Lisp function. * test/automated/advice-tests.el (advice-tests--data): Remove. (advice-tests): Move the tests directly here instead. Add called-interactively-p tests. --- test/ChangeLog | 6 ++ test/automated/advice-tests.el | 129 +++++++++++++++++++++++------------------ 2 files changed, 77 insertions(+), 58 deletions(-) (limited to 'test') diff --git a/test/ChangeLog b/test/ChangeLog index 75903ae3ef4..b66c2925287 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,9 @@ +2012-11-20 Stefan Monnier + + * automated/advice-tests.el (advice-tests--data): Remove. + (advice-tests): Move the tests directly here instead. + Add called-interactively-p tests. + 2012-11-19 Stefan Monnier * automated/ert-x-tests.el: Use cl-lib. diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el index 80321f8f3f9..94f69e77e43 100644 --- a/test/automated/advice-tests.el +++ b/test/automated/advice-tests.el @@ -21,81 +21,94 @@ ;;; Code: -(defvar advice-tests--data - '(((defun sm-test1 (x) (+ x 4)) - (sm-test1 6) 10) - ((advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) - (sm-test1 6) 50) - ((defun sm-test1 (x) (+ x 14)) - (sm-test1 6) 100) - ((null (get 'sm-test1 'defalias-fset-function)) nil) - ((advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) - (sm-test1 6) 20) - ((null (get 'sm-test1 'defalias-fset-function)) t) - - ((defun sm-test2 (x) (+ x 4)) - (sm-test2 6) 10) - ((defadvice sm-test2 (around sm-test activate) +(ert-deftest advice-tests () + "Test advice code." + (with-temp-buffer + (defun sm-test1 (x) (+ x 4)) + (should (equal (sm-test1 6) 10)) + (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test1 6) 50)) + (defun sm-test1 (x) (+ x 14)) + (should (equal (sm-test1 6) 100)) + (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil)) + (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test1 6) 20)) + (should (equal (null (get 'sm-test1 'defalias-fset-function)) t)) + + (defun sm-test2 (x) (+ x 4)) + (should (equal (sm-test2 6) 10)) + (defadvice sm-test2 (around sm-test activate) ad-do-it (setq ad-return-value (* ad-return-value 5))) - (sm-test2 6) 50) - ((ad-deactivate 'sm-test2) - (sm-test2 6) 10) - ((ad-activate 'sm-test2) - (sm-test2 6) 50) - ((defun sm-test2 (x) (+ x 14)) - (sm-test2 6) 100) - ((null (get 'sm-test2 'defalias-fset-function)) nil) - ((ad-remove-advice 'sm-test2 'around 'sm-test) - (sm-test2 6) 100) - ((ad-activate 'sm-test2) - (sm-test2 6) 20) - ((null (get 'sm-test2 'defalias-fset-function)) t) - - ((advice-add 'sm-test3 :around + (should (equal (sm-test2 6) 50)) + (ad-deactivate 'sm-test2) + (should (equal (sm-test2 6) 10)) + (ad-activate 'sm-test2) + (should (equal (sm-test2 6) 50)) + (defun sm-test2 (x) (+ x 14)) + (should (equal (sm-test2 6) 100)) + (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil)) + (ad-remove-advice 'sm-test2 'around 'sm-test) + (should (equal (sm-test2 6) 100)) + (ad-activate 'sm-test2) + (should (equal (sm-test2 6) 20)) + (should (equal (null (get 'sm-test2 'defalias-fset-function)) t)) + + (advice-add 'sm-test3 :around (lambda (f &rest args) `(toto ,(apply f args))) '((name . wrap-with-toto))) (defmacro sm-test3 (x) `(call-test3 ,x)) - (macroexpand '(sm-test3 56)) (toto (call-test3 56))) + (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))) - ((defadvice sm-test4 (around wrap-with-toto activate) + (defadvice sm-test4 (around wrap-with-toto activate) ad-do-it (setq ad-return-value `(toto ,ad-return-value))) (defmacro sm-test4 (x) `(call-test4 ,x)) - (macroexpand '(sm-test4 56)) (toto (call-test4 56))) - ((defmacro sm-test4 (x) `(call-testq ,x)) - (macroexpand '(sm-test4 56)) (toto (call-testq 56))) + (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56)))) + (defmacro sm-test4 (x) `(call-testq ,x)) + (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56)))) ;; Combining old style and new style advices. - ((defun sm-test5 (x) (+ x 4)) - (sm-test5 6) 10) - ((advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) - (sm-test5 6) 50) - ((defadvice sm-test5 (around test activate) + (defun sm-test5 (x) (+ x 4)) + (should (equal (sm-test5 6) 10)) + (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test5 6) 50)) + (defadvice sm-test5 (around test activate) ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) - (sm-test5 5) 45.1) - ((ad-deactivate 'sm-test5) - (sm-test5 6) 50) - ((ad-activate 'sm-test5) - (sm-test5 6) 50.1) - ((defun sm-test5 (x) (+ x 14)) - (sm-test5 6) 100.1) - ((advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) - (sm-test5 6) 20.1) + (should (equal (sm-test5 5) 45.1)) + (ad-deactivate 'sm-test5) + (should (equal (sm-test5 6) 50)) + (ad-activate 'sm-test5) + (should (equal (sm-test5 6) 50.1)) + (defun sm-test5 (x) (+ x 14)) + (should (equal (sm-test5 6) 100.1)) + (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test5 6) 20.1)) ;; This used to signal an error (bug#12858). - ((autoload 'sm-test6 "foo") + (autoload 'sm-test6 "foo") (defadvice sm-test6 (around test activate) ad-do-it) - t t) + ;; Check interaction between advice and called-interactively-p. + (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4)) + (advice-add 'sm-test7 :around + (lambda (f &rest args) + (list (cons 1 (called-interactively-p)) (apply f args)))) + (should (equal (sm-test7) '((1 . nil) 11))) + (should (equal (call-interactively 'sm-test7) '((1 . t) 11))) + (let ((smi 7)) + (advice-add 'sm-test7 :before + (lambda (&rest args) + (setq smi (called-interactively-p)))) + (should (equal (list (sm-test7) smi) + '(((1 . nil) 11) nil))) + (should (equal (list (call-interactively 'sm-test7) smi) + '(((1 . t) 11) t)))) + (advice-add 'sm-test7 :around + (lambda (f &rest args) + (cons (cons 2 (called-interactively-p)) (apply f args)))) + (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))) )) -(ert-deftest advice-tests () - "Test advice code." - (with-temp-buffer - (dolist (test advice-tests--data) - (let ((res (eval `(progn ,@(butlast test))))) - (should (equal (car (last test)) res)))))) - ;; Local Variables: ;; no-byte-compile: t ;; End: -- cgit v1.2.1