4 files changed, 176 insertions, 150 deletions

diff --git a/test/ChangeLog b/test/ChangeLog
index f11325d0318..b66c2925287 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,14 @@
+2012-11-20  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * 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  <monnier@iro.umontreal.ca>
+
+        * automated/ert-x-tests.el: Use cl-lib.
+        * automated/ert-tests.el: Use lexical-binding and cl-lib.
+
 2012-11-14  Dmitry Gutov  <dgutov@yandex.ru>
 
         * automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass.
@@ -5,8 +16,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  <dgutov@yandex.ru>
 
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:
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)