From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Sat, 8 Nov 2014 17:46:21 +0000 (-0500)
Subject: * lisp/emacs-lisp/bytecomp.el: Add a warning and remove a spurious warning.
X-Git-Tag: emacs-25.0.90~2635^2~536
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=97cd730164baf67617e1031730105523315c068f;p=emacs.git

* lisp/emacs-lisp/bytecomp.el: Add a warning and remove a spurious warning.
(byte-compile-initial-macro-environment): Don't compile before eval in
`eval-and-compile'.
(byte-compile-arglist-warn): Add check for defining macros after their
first use.  Check call use even if the function is fboundp.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index aac6ba5d739..a67f9220bbb 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2014-11-08  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
+	Don't compile before eval in `eval-and-compile'.
+	(byte-compile-arglist-warn): Add check for defining macros after their
+	first use.  Check call use even if the function is fboundp.
+
 2014-11-08  Richard Stallman  <rms@gnu.org>
 
 	* mail/rmail.el (rmail-epa-decrypt): Detect armor with line prefixes.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 392f6ee83cd..7fd72dd7705 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -461,10 +461,13 @@ Return the compile-time value of FORM."
                                  (byte-compile-recurse-toplevel
                                   (cons 'progn body)
                                   (lambda (form)
-                                    (let ((compiled (byte-compile-top-level
-                                                     (byte-compile-preprocess form))))
-                                      (eval compiled lexical-binding)
-                                      compiled))))))
+                                    ;; Don't compile here, since we don't know
+                                    ;; whether to compile as byte-compile-form
+                                    ;; or byte-compile-file-form.
+                                    (let ((expanded
+                                           (byte-compile-preprocess form)))
+                                      (eval expanded lexical-binding)
+                                      expanded))))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
 expanded by the compiler as when expanded by the interpreter.")
@@ -1361,6 +1364,33 @@ extra args."
 ;; Warn if the function or macro is being redefined with a different
 ;; number of arguments.
 (defun byte-compile-arglist-warn (name arglist macrop)
+  ;; This is the first definition.  See if previous calls are compatible.
+  (let ((calls (assq name byte-compile-unresolved-functions))
+        nums sig min max)
+    (when (and calls macrop)
+      (byte-compile-warn "macro `%s' defined too late" name))
+    (setq byte-compile-unresolved-functions
+          (delq calls byte-compile-unresolved-functions))
+    (setq calls (delq t calls))      ;Ignore higher-order uses of the function.
+    (when (cdr calls)
+      (when (and (symbolp name)
+                 (eq (function-get name 'byte-optimizer)
+                     'byte-compile-inline-expand))
+        (byte-compile-warn "defsubst `%s' was used before it was defined"
+                           name))
+      (setq sig (byte-compile-arglist-signature arglist)
+            nums (sort (copy-sequence (cdr calls)) (function <))
+            min (car nums)
+            max (car (nreverse nums)))
+      (when (or (< min (car sig))
+                (and (cdr sig) (> max (cdr sig))))
+        (byte-compile-set-symbol-position name)
+        (byte-compile-warn
+         "%s being defined to take %s%s, but was previously called with %s"
+         name
+         (byte-compile-arglist-signature-string sig)
+         (if (equal sig '(1 . 1)) " arg" " args")
+         (byte-compile-arglist-signature-string (cons min max))))))
   (let* ((old (byte-compile-fdefinition name macrop))
          (initial (and macrop
                        (cdr (assq name
@@ -1369,52 +1399,26 @@ extra args."
     ;; to a defined function.  (Bug#8646)
     (and initial (symbolp initial)
          (setq old (byte-compile-fdefinition initial nil)))
-    (if (and old (not (eq old t)))
-	(progn
-	  (and (eq 'macro (car-safe old))
-	       (eq 'lambda (car-safe (cdr-safe old)))
-	       (setq old (cdr old)))
-	  (let ((sig1 (byte-compile-arglist-signature
-		       (pcase old
-                         (`(lambda ,args . ,_) args)
-                         (`(closure ,_ ,args . ,_) args)
-                         ((pred byte-code-function-p) (aref old 0))
-                         (t '(&rest def)))))
-		(sig2 (byte-compile-arglist-signature arglist)))
-	    (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
-	      (byte-compile-set-symbol-position name)
-	      (byte-compile-warn
-	       "%s %s used to take %s %s, now takes %s"
-	       (if macrop "macro" "function")
-	       name
-	       (byte-compile-arglist-signature-string sig1)
-	       (if (equal sig1 '(1 . 1)) "argument" "arguments")
-	       (byte-compile-arglist-signature-string sig2)))))
-      ;; This is the first definition.  See if previous calls are compatible.
-      (let ((calls (assq name byte-compile-unresolved-functions))
-	    nums sig min max)
-        (setq byte-compile-unresolved-functions
-              (delq calls byte-compile-unresolved-functions))
-        (setq calls (delq t calls))  ;Ignore higher-order uses of the function.
-	(when (cdr calls)
-          (when (and (symbolp name)
-                     (eq (function-get name 'byte-optimizer)
-                         'byte-compile-inline-expand))
-            (byte-compile-warn "defsubst `%s' was used before it was defined"
-		       name))
-          (setq sig (byte-compile-arglist-signature arglist)
-                nums (sort (copy-sequence (cdr calls)) (function <))
-                min (car nums)
-                max (car (nreverse nums)))
-          (when (or (< min (car sig))
-                    (and (cdr sig) (> max (cdr sig))))
-            (byte-compile-set-symbol-position name)
-            (byte-compile-warn
-             "%s being defined to take %s%s, but was previously called with %s"
-             name
-             (byte-compile-arglist-signature-string sig)
-             (if (equal sig '(1 . 1)) " arg" " args")
-             (byte-compile-arglist-signature-string (cons min max)))))))))
+    (when (and old (not (eq old t)))
+      (and (eq 'macro (car-safe old))
+           (eq 'lambda (car-safe (cdr-safe old)))
+           (setq old (cdr old)))
+      (let ((sig1 (byte-compile-arglist-signature
+                   (pcase old
+                     (`(lambda ,args . ,_) args)
+                     (`(closure ,_ ,args . ,_) args)
+                     ((pred byte-code-function-p) (aref old 0))
+                     (t '(&rest def)))))
+            (sig2 (byte-compile-arglist-signature arglist)))
+        (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
+          (byte-compile-set-symbol-position name)
+          (byte-compile-warn
+           "%s %s used to take %s %s, now takes %s"
+           (if macrop "macro" "function")
+           name
+           (byte-compile-arglist-signature-string sig1)
+           (if (equal sig1 '(1 . 1)) "argument" "arguments")
+           (byte-compile-arglist-signature-string sig2)))))))
 
 (defvar byte-compile-cl-functions nil
   "List of functions defined in CL.")
diff --git a/test/automated/bytecomp-tests.el b/test/automated/bytecomp-tests.el
index 1d96f1cdfce..2bdc3c5bf12 100644
--- a/test/automated/bytecomp-tests.el
+++ b/test/automated/bytecomp-tests.el
@@ -316,12 +316,12 @@ Subtests signal errors if something goes wrong."
            (with-temp-buffer
              (dolist (form forms)
                (print form (current-buffer)))
-             (write-region (point-min) (point-max) elfile))
+             (write-region (point-min) (point-max) elfile nil 'silent))
            (if compile
                (let ((byte-compile-dest-file-function
                       (lambda (e) elcfile)))
                  (byte-compile-file elfile t))
-             (load elfile)))
+             (load elfile nil 'nomessage)))
       (when elfile (delete-file elfile))
       (when elcfile (delete-file elcfile)))))
 (put 'test-byte-comp-compile-and-load 'lisp-indent-function 1)
@@ -360,6 +360,28 @@ Subtests signal errors if something goes wrong."
       (defun def () (m))))
   (should (equal (funcall 'def) 4)))
 
+(ert-deftest bytecomp-tests--warnings ()
+  (with-current-buffer (get-buffer-create "*Compile-Log*")
+    (let ((inhibit-read-only t)) (erase-buffer)))
+  (test-byte-comp-compile-and-load t
+    '(progn
+       (defun my-test0 ()
+         (my--test11 3)
+         (my--test12 3)
+         (my--test2 5))
+       (defmacro my--test11 (arg) (+ arg 1))
+       (eval-and-compile
+         (defmacro my--test12 (arg) (+ arg 1))
+         (defun my--test2 (arg) (+ arg 1)))))
+  (with-current-buffer (get-buffer-create "*Compile-Log*")
+    (goto-char (point-min))
+    ;; Should warn that mt--test1[12] are first used as functions.
+    (should (re-search-forward "my--test11:\n.*macro" nil t))
+    (should (re-search-forward "my--test12:\n.*macro" nil t))
+    (goto-char (point-min))
+    ;; Should not warn that mt--test2 is not known to be defined.
+    (should-not (re-search-forward "my--test2" nil t))))
+
 (ert-deftest test-eager-load-macro-expansion ()
   (test-byte-comp-compile-and-load nil
     '(progn (defmacro abc (arg) 1) (defun def () (abc 2))))
diff --git a/test/automated/cl-lib-tests.el b/test/automated/cl-lib-tests.el
new file mode 100644
index 00000000000..e4c6e914ee2
--- /dev/null
+++ b/test/automated/cl-lib-tests.el
@@ -0,0 +1,248 @@
+;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el
+
+;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;; Extracted from ert-tests.el, back when ert used to reimplement some
+;; cl functions.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+
+(ert-deftest cl-lib-test-remprop ()
+  (let ((x (cl-gensym)))
+    (should (equal (symbol-plist x) '()))
+    ;; Remove nonexistent property on empty plist.
+    (cl-remprop x 'b)
+    (should (equal (symbol-plist x) '()))
+    (put x 'a 1)
+    (should (equal (symbol-plist x) '(a 1)))
+    ;; Remove nonexistent property on nonempty plist.
+    (cl-remprop x 'b)
+    (should (equal (symbol-plist x) '(a 1)))
+    (put x 'b 2)
+    (put x 'c 3)
+    (put x 'd 4)
+    (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4)))
+    ;; Remove property that is neither first nor last.
+    (cl-remprop x 'c)
+    (should (equal (symbol-plist x) '(a 1 b 2 d 4)))
+    ;; Remove last property from a plist of length >1.
+    (cl-remprop x 'd)
+    (should (equal (symbol-plist x) '(a 1 b 2)))
+    ;; Remove first property from a plist of length >1.
+    (cl-remprop x 'a)
+    (should (equal (symbol-plist x) '(b 2)))
+    ;; Remove property when there is only one.
+    (cl-remprop x 'b)
+    (should (equal (symbol-plist x) '()))))
+
+(ert-deftest cl-lib-test-remove-if-not ()
+  (let ((list (list 'a 'b 'c 'd))
+        (i 0))
+    (let ((result (cl-remove-if-not (lambda (x)
+                                        (should (eql x (nth i list)))
+                                        (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 '()
+                 (cl-remove-if-not (lambda (_x) (should nil)) '()))))
+
+(ert-deftest cl-lib-test-remove ()
+  (let ((list (list 'a 'b 'c 'd))
+        (key-index 0)
+        (test-index 0))
+    (let ((result
+           (cl-remove 'foo list
+                         :key (lambda (x)
+                                (should (eql x (nth key-index list)))
+                                (prog1
+                                    (list key-index x)
+                                  (cl-incf key-index)))
+                         :test
+                         (lambda (a b)
+                           (should (eql a 'foo))
+                           (should (equal b (list test-index
+                                                  (nth test-index list))))
+                           (cl-incf test-index)
+                           (member test-index '(2 3))))))
+      (should (equal key-index 4))
+      (should (equal test-index 4))
+      (should (equal result '(a d)))
+      (should (equal list '(a b c d)))))
+  (let ((x (cons nil nil))
+        (y (cons nil nil)))
+    (should (equal (cl-remove x (list x y))
+                   ;; or (list x), since we use `equal' -- the
+                   ;; important thing is that only one element got
+                   ;; removed, this proves that the default test is
+                   ;; `eql', not `equal'
+                   (list y)))))
+
+
+(ert-deftest cl-lib-test-set-functions ()
+  (let ((c1 (cons nil nil))
+        (c2 (cons nil nil))
+        (sym (make-symbol "a")))
+    (let ((e '())
+          (a (list 'a 'b sym nil "" "x" c1 c2))
+          (b (list c1 'y 'b sym 'x)))
+      (should (equal (cl-set-difference e e) e))
+      (should (equal (cl-set-difference a e) a))
+      (should (equal (cl-set-difference e a) e))
+      (should (equal (cl-set-difference a a) e))
+      (should (equal (cl-set-difference b e) b))
+      (should (equal (cl-set-difference e b) e))
+      (should (equal (cl-set-difference b b) e))
+      ;; Note: this test (and others) is sensitive to the order of the
+      ;; result, which is not documented.
+      (should (equal (cl-set-difference a b) (list c2 "x" "" nil 'a)))
+      (should (equal (cl-set-difference b a) (list 'x 'y)))
+
+      ;; We aren't testing whether this is really using `eq' rather than `eql'.
+      (should (equal (cl-set-difference e e :test 'eq) e))
+      (should (equal (cl-set-difference a e :test 'eq) a))
+      (should (equal (cl-set-difference e a :test 'eq) e))
+      (should (equal (cl-set-difference a a :test 'eq) e))
+      (should (equal (cl-set-difference b e :test 'eq) b))
+      (should (equal (cl-set-difference e b :test 'eq) e))
+      (should (equal (cl-set-difference b b :test 'eq) e))
+      (should (equal (cl-set-difference a b :test 'eq) (list c2 "x" "" nil 'a)))
+      (should (equal (cl-set-difference b a :test 'eq) (list 'x 'y)))
+
+      (should (equal (cl-union e e) e))
+      (should (equal (cl-union a e) a))
+      (should (equal (cl-union e a) a))
+      (should (equal (cl-union a a) a))
+      (should (equal (cl-union b e) b))
+      (should (equal (cl-union e b) b))
+      (should (equal (cl-union b b) b))
+      (should (equal (cl-union a b) (list 'x 'y 'a 'b sym nil "" "x" c1 c2)))
+
+      (should (equal (cl-union b a) (list 'x 'y 'a 'b sym nil "" "x" c1 c2)))
+
+      (should (equal (cl-intersection e e) e))
+      (should (equal (cl-intersection a e) e))
+      (should (equal (cl-intersection e a) e))
+      (should (equal (cl-intersection a a) a))
+      (should (equal (cl-intersection b e) e))
+      (should (equal (cl-intersection e b) e))
+      (should (equal (cl-intersection b b) b))
+      (should (equal (cl-intersection a b) (list sym 'b c1)))
+      (should (equal (cl-intersection b a) (list sym 'b c1))))))
+
+(ert-deftest cl-lib-test-gensym ()
+  ;; Since the expansion of `should' calls `cl-gensym' and thus has a
+  ;; side-effect on `cl--gensym-counter', we have to make sure all
+  ;; macros in our test body are expanded before we rebind
+  ;; `cl--gensym-counter' and run the body.  Otherwise, the test would
+  ;; fail if run interpreted.
+  (let ((body (byte-compile
+               '(lambda ()
+                  (should (equal (symbol-name (cl-gensym)) "G0"))
+                  (should (equal (symbol-name (cl-gensym)) "G1"))
+                  (should (equal (symbol-name (cl-gensym)) "G2"))
+                  (should (equal (symbol-name (cl-gensym "foo")) "foo3"))
+                  (should (equal (symbol-name (cl-gensym "bar")) "bar4"))
+                  (should (equal cl--gensym-counter 5))))))
+    (let ((cl--gensym-counter 0))
+      (funcall body))))
+
+(ert-deftest cl-lib-test-coerce-to-vector ()
+  (let* ((a (vector))
+         (b (vector 1 a 3))
+         (c (list))
+         (d (list b a)))
+    (should (eql (cl-coerce a 'vector) a))
+    (should (eql (cl-coerce b 'vector) b))
+    (should (equal (cl-coerce c 'vector) (vector)))
+    (should (equal (cl-coerce d 'vector) (vector b a)))))
+
+(ert-deftest cl-lib-test-string-position ()
+  (should (eql (cl-position ?x "") nil))
+  (should (eql (cl-position ?a "abc") 0))
+  (should (eql (cl-position ?b "abc") 1))
+  (should (eql (cl-position ?c "abc") 2))
+  (should (eql (cl-position ?d "abc") nil))
+  (should (eql (cl-position ?A "abc") nil)))
+
+(ert-deftest cl-lib-test-mismatch ()
+  (should (eql (cl-mismatch "" "") nil))
+  (should (eql (cl-mismatch "" "a") 0))
+  (should (eql (cl-mismatch "a" "a") nil))
+  (should (eql (cl-mismatch "ab" "a") 1))
+  (should (eql (cl-mismatch "Aa" "aA") 0))
+  (should (eql (cl-mismatch '(a b c) '(a b d)) 2)))
+
+(ert-deftest cl-lib-test-loop ()
+  (should (eql (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6)))
+
+(ert-deftest cl-lib-keyword-names-versus-values ()
+  (should (equal
+           (funcall (cl-function (lambda (&key a b) (list a b)))
+                    :b :a :a 42)
+           '(42 :a))))
+
+(cl-defstruct mystruct (abc :readonly t) def)
+(ert-deftest cl-lib-struct-accessors ()
+  (let ((x (make-mystruct :abc 1 :def 2)))
+    (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1))
+    (should (eql (cl-struct-slot-value 'mystruct 'def x) 2))
+    (setf (cl-struct-slot-value 'mystruct 'def x) -1)
+    (should (eql (cl-struct-slot-value 'mystruct 'def x) -1))
+    (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1))
+    (should-error (cl-struct-slot-offset 'mystruct 'marypoppins))
+    (should (equal (cl-struct-slot-info 'mystruct)
+                   '((cl-tag-slot) (abc :readonly t) (def))))))
+
+(ert-deftest cl-the ()
+  (should (eql (cl-the integer 42) 42))
+  (should-error (cl-the integer "abc"))
+  (let ((side-effect 0))
+    (should (= (cl-the integer (cl-incf side-effect)) 1))
+    (should (= side-effect 1))))
+
+(ert-deftest cl-digit-char-p ()
+  (should (cl-digit-char-p ?3))
+  (should (cl-digit-char-p ?a 11))
+  (should-not (cl-digit-char-p ?a))
+  (should (cl-digit-char-p ?w 36))
+  (should-error (cl-digit-char-p ?a 37))
+  (should-error (cl-digit-char-p ?a 1)))
+
+(ert-deftest cl-parse-integer ()
+  (should-error (cl-parse-integer "abc"))
+  (should (null (cl-parse-integer "abc" :junk-allowed t)))
+  (should (null (cl-parse-integer "" :junk-allowed t)))
+  (should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t)))
+  (should-error (cl-parse-integer "0123456789" :radix 8))
+  (should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t)))
+  (should-error (cl-parse-integer "efz" :radix 16))
+  (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2)))
+  (should (= -123 (cl-parse-integer "	-123  "))))
+
+(ert-deftest cl-loop-destructuring-with ()
+  (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6)))
+
+;;; cl-lib.el ends here
diff --git a/test/automated/cl-lib.el b/test/automated/cl-lib.el
deleted file mode 100644
index e4c6e914ee2..00000000000
--- a/test/automated/cl-lib.el
+++ /dev/null
@@ -1,248 +0,0 @@
-;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el
-
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
-
-;;; Commentary:
-
-;; Extracted from ert-tests.el, back when ert used to reimplement some
-;; cl functions.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'ert)
-
-(ert-deftest cl-lib-test-remprop ()
-  (let ((x (cl-gensym)))
-    (should (equal (symbol-plist x) '()))
-    ;; Remove nonexistent property on empty plist.
-    (cl-remprop x 'b)
-    (should (equal (symbol-plist x) '()))
-    (put x 'a 1)
-    (should (equal (symbol-plist x) '(a 1)))
-    ;; Remove nonexistent property on nonempty plist.
-    (cl-remprop x 'b)
-    (should (equal (symbol-plist x) '(a 1)))
-    (put x 'b 2)
-    (put x 'c 3)
-    (put x 'd 4)
-    (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4)))
-    ;; Remove property that is neither first nor last.
-    (cl-remprop x 'c)
-    (should (equal (symbol-plist x) '(a 1 b 2 d 4)))
-    ;; Remove last property from a plist of length >1.
-    (cl-remprop x 'd)
-    (should (equal (symbol-plist x) '(a 1 b 2)))
-    ;; Remove first property from a plist of length >1.
-    (cl-remprop x 'a)
-    (should (equal (symbol-plist x) '(b 2)))
-    ;; Remove property when there is only one.
-    (cl-remprop x 'b)
-    (should (equal (symbol-plist x) '()))))
-
-(ert-deftest cl-lib-test-remove-if-not ()
-  (let ((list (list 'a 'b 'c 'd))
-        (i 0))
-    (let ((result (cl-remove-if-not (lambda (x)
-                                        (should (eql x (nth i list)))
-                                        (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 '()
-                 (cl-remove-if-not (lambda (_x) (should nil)) '()))))
-
-(ert-deftest cl-lib-test-remove ()
-  (let ((list (list 'a 'b 'c 'd))
-        (key-index 0)
-        (test-index 0))
-    (let ((result
-           (cl-remove 'foo list
-                         :key (lambda (x)
-                                (should (eql x (nth key-index list)))
-                                (prog1
-                                    (list key-index x)
-                                  (cl-incf key-index)))
-                         :test
-                         (lambda (a b)
-                           (should (eql a 'foo))
-                           (should (equal b (list test-index
-                                                  (nth test-index list))))
-                           (cl-incf test-index)
-                           (member test-index '(2 3))))))
-      (should (equal key-index 4))
-      (should (equal test-index 4))
-      (should (equal result '(a d)))
-      (should (equal list '(a b c d)))))
-  (let ((x (cons nil nil))
-        (y (cons nil nil)))
-    (should (equal (cl-remove x (list x y))
-                   ;; or (list x), since we use `equal' -- the
-                   ;; important thing is that only one element got
-                   ;; removed, this proves that the default test is
-                   ;; `eql', not `equal'
-                   (list y)))))
-
-
-(ert-deftest cl-lib-test-set-functions ()
-  (let ((c1 (cons nil nil))
-        (c2 (cons nil nil))
-        (sym (make-symbol "a")))
-    (let ((e '())
-          (a (list 'a 'b sym nil "" "x" c1 c2))
-          (b (list c1 'y 'b sym 'x)))
-      (should (equal (cl-set-difference e e) e))
-      (should (equal (cl-set-difference a e) a))
-      (should (equal (cl-set-difference e a) e))
-      (should (equal (cl-set-difference a a) e))
-      (should (equal (cl-set-difference b e) b))
-      (should (equal (cl-set-difference e b) e))
-      (should (equal (cl-set-difference b b) e))
-      ;; Note: this test (and others) is sensitive to the order of the
-      ;; result, which is not documented.
-      (should (equal (cl-set-difference a b) (list c2 "x" "" nil 'a)))
-      (should (equal (cl-set-difference b a) (list 'x 'y)))
-
-      ;; We aren't testing whether this is really using `eq' rather than `eql'.
-      (should (equal (cl-set-difference e e :test 'eq) e))
-      (should (equal (cl-set-difference a e :test 'eq) a))
-      (should (equal (cl-set-difference e a :test 'eq) e))
-      (should (equal (cl-set-difference a a :test 'eq) e))
-      (should (equal (cl-set-difference b e :test 'eq) b))
-      (should (equal (cl-set-difference e b :test 'eq) e))
-      (should (equal (cl-set-difference b b :test 'eq) e))
-      (should (equal (cl-set-difference a b :test 'eq) (list c2 "x" "" nil 'a)))
-      (should (equal (cl-set-difference b a :test 'eq) (list 'x 'y)))
-
-      (should (equal (cl-union e e) e))
-      (should (equal (cl-union a e) a))
-      (should (equal (cl-union e a) a))
-      (should (equal (cl-union a a) a))
-      (should (equal (cl-union b e) b))
-      (should (equal (cl-union e b) b))
-      (should (equal (cl-union b b) b))
-      (should (equal (cl-union a b) (list 'x 'y 'a 'b sym nil "" "x" c1 c2)))
-
-      (should (equal (cl-union b a) (list 'x 'y 'a 'b sym nil "" "x" c1 c2)))
-
-      (should (equal (cl-intersection e e) e))
-      (should (equal (cl-intersection a e) e))
-      (should (equal (cl-intersection e a) e))
-      (should (equal (cl-intersection a a) a))
-      (should (equal (cl-intersection b e) e))
-      (should (equal (cl-intersection e b) e))
-      (should (equal (cl-intersection b b) b))
-      (should (equal (cl-intersection a b) (list sym 'b c1)))
-      (should (equal (cl-intersection b a) (list sym 'b c1))))))
-
-(ert-deftest cl-lib-test-gensym ()
-  ;; Since the expansion of `should' calls `cl-gensym' and thus has a
-  ;; side-effect on `cl--gensym-counter', we have to make sure all
-  ;; macros in our test body are expanded before we rebind
-  ;; `cl--gensym-counter' and run the body.  Otherwise, the test would
-  ;; fail if run interpreted.
-  (let ((body (byte-compile
-               '(lambda ()
-                  (should (equal (symbol-name (cl-gensym)) "G0"))
-                  (should (equal (symbol-name (cl-gensym)) "G1"))
-                  (should (equal (symbol-name (cl-gensym)) "G2"))
-                  (should (equal (symbol-name (cl-gensym "foo")) "foo3"))
-                  (should (equal (symbol-name (cl-gensym "bar")) "bar4"))
-                  (should (equal cl--gensym-counter 5))))))
-    (let ((cl--gensym-counter 0))
-      (funcall body))))
-
-(ert-deftest cl-lib-test-coerce-to-vector ()
-  (let* ((a (vector))
-         (b (vector 1 a 3))
-         (c (list))
-         (d (list b a)))
-    (should (eql (cl-coerce a 'vector) a))
-    (should (eql (cl-coerce b 'vector) b))
-    (should (equal (cl-coerce c 'vector) (vector)))
-    (should (equal (cl-coerce d 'vector) (vector b a)))))
-
-(ert-deftest cl-lib-test-string-position ()
-  (should (eql (cl-position ?x "") nil))
-  (should (eql (cl-position ?a "abc") 0))
-  (should (eql (cl-position ?b "abc") 1))
-  (should (eql (cl-position ?c "abc") 2))
-  (should (eql (cl-position ?d "abc") nil))
-  (should (eql (cl-position ?A "abc") nil)))
-
-(ert-deftest cl-lib-test-mismatch ()
-  (should (eql (cl-mismatch "" "") nil))
-  (should (eql (cl-mismatch "" "a") 0))
-  (should (eql (cl-mismatch "a" "a") nil))
-  (should (eql (cl-mismatch "ab" "a") 1))
-  (should (eql (cl-mismatch "Aa" "aA") 0))
-  (should (eql (cl-mismatch '(a b c) '(a b d)) 2)))
-
-(ert-deftest cl-lib-test-loop ()
-  (should (eql (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6)))
-
-(ert-deftest cl-lib-keyword-names-versus-values ()
-  (should (equal
-           (funcall (cl-function (lambda (&key a b) (list a b)))
-                    :b :a :a 42)
-           '(42 :a))))
-
-(cl-defstruct mystruct (abc :readonly t) def)
-(ert-deftest cl-lib-struct-accessors ()
-  (let ((x (make-mystruct :abc 1 :def 2)))
-    (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1))
-    (should (eql (cl-struct-slot-value 'mystruct 'def x) 2))
-    (setf (cl-struct-slot-value 'mystruct 'def x) -1)
-    (should (eql (cl-struct-slot-value 'mystruct 'def x) -1))
-    (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1))
-    (should-error (cl-struct-slot-offset 'mystruct 'marypoppins))
-    (should (equal (cl-struct-slot-info 'mystruct)
-                   '((cl-tag-slot) (abc :readonly t) (def))))))
-
-(ert-deftest cl-the ()
-  (should (eql (cl-the integer 42) 42))
-  (should-error (cl-the integer "abc"))
-  (let ((side-effect 0))
-    (should (= (cl-the integer (cl-incf side-effect)) 1))
-    (should (= side-effect 1))))
-
-(ert-deftest cl-digit-char-p ()
-  (should (cl-digit-char-p ?3))
-  (should (cl-digit-char-p ?a 11))
-  (should-not (cl-digit-char-p ?a))
-  (should (cl-digit-char-p ?w 36))
-  (should-error (cl-digit-char-p ?a 37))
-  (should-error (cl-digit-char-p ?a 1)))
-
-(ert-deftest cl-parse-integer ()
-  (should-error (cl-parse-integer "abc"))
-  (should (null (cl-parse-integer "abc" :junk-allowed t)))
-  (should (null (cl-parse-integer "" :junk-allowed t)))
-  (should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t)))
-  (should-error (cl-parse-integer "0123456789" :radix 8))
-  (should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t)))
-  (should-error (cl-parse-integer "efz" :radix 16))
-  (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2)))
-  (should (= -123 (cl-parse-integer "	-123  "))))
-
-(ert-deftest cl-loop-destructuring-with ()
-  (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6)))
-
-;;; cl-lib.el ends here