Rename all test files to reflect source layout.

* CONTRIBUTE,Makefile.in,configure.ac: Update to reflect test directory moves. * test/file-organisation.org: New file. * test/automated/Makefile.in test/automated/data/decompress/foo.gz test/automated/data/epg/pubkey.asc test/automated/data/epg/seckey.asc test/automated/data/files-bug18141.el.gz test/automated/data/flymake/test.c test/automated/data/flymake/test.pl test/automated/data/package/archive-contents test/automated/data/package/key.pub test/automated/data/package/key.sec test/automated/data/package/multi-file-0.2.3.tar test/automated/data/package/multi-file-readme.txt test/automated/data/package/newer-versions/archive-contents test/automated/data/package/newer-versions/new-pkg-1.0.el test/automated/data/package/newer-versions/simple-single-1.4.el test/automated/data/package/package-test-server.py test/automated/data/package/signed/archive-contents test/automated/data/package/signed/archive-contents.sig test/automated/data/package/signed/signed-bad-1.0.el test/automated/data/package/signed/signed-bad-1.0.el.sig test/automated/data/package/signed/signed-good-1.0.el test/automated/data/package/signed/signed-good-1.0.el.sig test/automated/data/package/simple-depend-1.0.el test/automated/data/package/simple-single-1.3.el test/automated/data/package/simple-single-readme.txt test/automated/data/package/simple-two-depend-1.1.el test/automated/abbrev-tests.el test/automated/auto-revert-tests.el test/automated/calc-tests.el test/automated/icalendar-tests.el test/automated/character-fold-tests.el test/automated/comint-testsuite.el test/automated/descr-text-test.el test/automated/electric-tests.el test/automated/cl-generic-tests.el test/automated/cl-lib-tests.el test/automated/eieio-test-methodinvoke.el test/automated/eieio-test-persist.el test/automated/eieio-tests.el test/automated/ert-tests.el test/automated/ert-x-tests.el test/automated/generator-tests.el test/automated/let-alist.el test/automated/map-tests.el test/automated/advice-tests.el test/automated/package-test.el test/automated/pcase-tests.el test/automated/regexp-tests.el test/automated/seq-tests.el test/automated/subr-x-tests.el test/automated/tabulated-list-test.el test/automated/thunk-tests.el test/automated/timer-tests.el test/automated/epg-tests.el test/automated/eshell.el test/automated/faces-tests.el test/automated/file-notify-tests.el test/automated/auth-source-tests.el test/automated/gnus-tests.el test/automated/message-mode-tests.el test/automated/help-fns.el test/automated/imenu-test.el test/automated/info-xref.el test/automated/mule-util.el test/automated/isearch-tests.el test/automated/json-tests.el test/automated/bytecomp-tests.el test/automated/coding-tests.el test/automated/core-elisp-tests.el test/automated/decoder-tests.el test/automated/files.el test/automated/font-parse-tests.el test/automated/lexbind-tests.el test/automated/occur-tests.el test/automated/process-tests.el test/automated/syntax-tests.el test/automated/textprop-tests.el test/automated/undo-tests.el test/automated/man-tests.el test/automated/completion-tests.el test/automated/dbus-tests.el test/automated/newsticker-tests.el test/automated/sasl-scram-rfc-tests.el test/automated/tramp-tests.el test/automated/obarray-tests.el test/automated/compile-tests.el test/automated/elisp-mode-tests.el test/automated/f90.el test/automated/flymake-tests.el test/automated/python-tests.el test/automated/ruby-mode-tests.el test/automated/subword-tests.el test/automated/replace-tests.el test/automated/simple-test.el test/automated/sort-tests.el test/automated/subr-tests.el test/automated/reftex-tests.el test/automated/sgml-mode-tests.el test/automated/tildify-tests.el test/automated/thingatpt.el test/automated/url-future-tests.el test/automated/url-util-tests.el test/automated/add-log-tests.el test/automated/vc-bzr.el test/automated/vc-tests.el test/automated/xml-parse-tests.el test/BidiCharacterTest.txt test/biditest.el test/cedet/cedet-utests.el test/cedet/ede-tests.el test/cedet/semantic-ia-utest.el test/cedet/semantic-tests.el test/cedet/semantic-utest-c.el test/cedet/semantic-utest.el test/cedet/srecode-tests.el test/cedet/tests/test.c test/cedet/tests/test.el test/cedet/tests/test.make test/cedet/tests/testdoublens.cpp test/cedet/tests/testdoublens.hpp test/cedet/tests/testfriends.cpp test/cedet/tests/testjavacomp.java test/cedet/tests/testnsp.cpp test/cedet/tests/testpolymorph.cpp test/cedet/tests/testspp.c test/cedet/tests/testsppcomplete.c test/cedet/tests/testsppreplace.c test/cedet/tests/testsppreplaced.c test/cedet/tests/testsubclass.cpp test/cedet/tests/testsubclass.hh test/cedet/tests/testtypedefs.cpp test/cedet/tests/testvarnames.c test/etags/CTAGS.good test/etags/ETAGS.good_1 test/etags/ETAGS.good_2 test/etags/ETAGS.good_3 test/etags/ETAGS.good_4 test/etags/ETAGS.good_5 test/etags/ETAGS.good_6 test/etags/a-src/empty.zz test/etags/a-src/empty.zz.gz test/etags/ada-src/2ataspri.adb test/etags/ada-src/2ataspri.ads test/etags/ada-src/etags-test-for.ada test/etags/ada-src/waroquiers.ada test/etags/c-src/a/b/b.c test/etags/c-src/abbrev.c test/etags/c-src/c.c test/etags/c-src/dostorture.c test/etags/c-src/emacs/src/gmalloc.c test/etags/c-src/emacs/src/keyboard.c test/etags/c-src/emacs/src/lisp.h test/etags/c-src/emacs/src/regex.h test/etags/c-src/etags.c test/etags/c-src/exit.c test/etags/c-src/exit.strange_suffix test/etags/c-src/fail.c test/etags/c-src/getopt.h test/etags/c-src/h.h test/etags/c-src/machsyscalls.c test/etags/c-src/machsyscalls.h test/etags/c-src/sysdep.h test/etags/c-src/tab.c test/etags/c-src/torture.c test/etags/cp-src/MDiagArray2.h test/etags/cp-src/Range.h test/etags/cp-src/burton.cpp test/etags/cp-src/c.C test/etags/cp-src/clheir.cpp.gz test/etags/cp-src/clheir.hpp test/etags/cp-src/conway.cpp test/etags/cp-src/conway.hpp test/etags/cp-src/fail.C test/etags/cp-src/functions.cpp test/etags/cp-src/screen.cpp test/etags/cp-src/screen.hpp test/etags/cp-src/x.cc test/etags/el-src/TAGTEST.EL test/etags/el-src/emacs/lisp/progmodes/etags.el test/etags/erl-src/gs_dialog.erl test/etags/f-src/entry.for test/etags/f-src/entry.strange.gz test/etags/f-src/entry.strange_suffix test/etags/forth-src/test-forth.fth test/etags/html-src/algrthms.html test/etags/html-src/index.shtml test/etags/html-src/software.html test/etags/html-src/softwarelibero.html test/etags/lua-src/allegro.lua test/etags/objc-src/PackInsp.h test/etags/objc-src/PackInsp.m test/etags/objc-src/Subprocess.h test/etags/objc-src/Subprocess.m test/etags/objcpp-src/SimpleCalc.H test/etags/objcpp-src/SimpleCalc.M test/etags/pas-src/common.pas test/etags/perl-src/htlmify-cystic test/etags/perl-src/kai-test.pl test/etags/perl-src/yagrip.pl test/etags/php-src/lce_functions.php test/etags/php-src/ptest.php test/etags/php-src/sendmail.php test/etags/prol-src/natded.prolog test/etags/prol-src/ordsets.prolog test/etags/ps-src/rfc1245.ps test/etags/pyt-src/server.py test/etags/tex-src/gzip.texi test/etags/tex-src/nonewline.tex test/etags/tex-src/testenv.tex test/etags/tex-src/texinfo.tex test/etags/y-src/atest.y test/etags/y-src/cccp.c test/etags/y-src/cccp.y test/etags/y-src/parse.c test/etags/y-src/parse.y test/indent/css-mode.css test/indent/js-indent-init-dynamic.js test/indent/js-indent-init-t.js test/indent/js-jsx.js test/indent/js.js test/indent/latex-mode.tex test/indent/modula2.mod test/indent/nxml.xml test/indent/octave.m test/indent/pascal.pas test/indent/perl.perl test/indent/prolog.prolog test/indent/ps-mode.ps test/indent/ruby.rb test/indent/scheme.scm test/indent/scss-mode.scss test/indent/sgml-mode-attribute.html test/indent/shell.rc test/indent/shell.sh test/redisplay-testsuite.el test/rmailmm.el test/automated/buffer-tests.el test/automated/cmds-tests.el test/automated/data-tests.el test/automated/finalizer-tests.el test/automated/fns-tests.el test/automated/inotify-test.el test/automated/keymap-tests.el test/automated/print-tests.el test/automated/libxml-tests.el test/automated/zlib-tests.el: Files Moved.
author: Phillip Lord <phillip.lord@russet.org.uk> 2015-11-23 22:02:42 +0000
committer: Phillip Lord <phillip.lord@russet.org.uk> 2015-11-24 17:04:22 +0000
commit: 22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e (patch)
tree: 779ff7e07667194416e01c6a6e8bd7b970244c70 /test/lisp/emacs-lisp
parent: c378d6c33f751d1a0b97958f3cacfe0b07c72f58 (diff)
download: emacs-22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e.tar.gz
emacs-22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e.tar.bz2
emacs-22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e.zip
19 files changed, 6080 insertions, 0 deletions
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
new file mode 100644
index 00000000000..2703b44dee5
--- /dev/null
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -0,0 +1,223 @@
+;;; cl-generic-tests.el --- Tests for cl-generic.el functionality  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'ert)) ;Don't indirectly require cl-lib at run-time.
+(require 'cl-generic)
+
+(fmakunbound 'cl--generic-1)
+(cl-defgeneric cl--generic-1 (x y))
+(cl-defgeneric (setf cl--generic-1) (v y z) "My generic doc.")
+
+(ert-deftest cl-generic-test-00 ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x y))
+  (cl-defmethod cl--generic-1 ((x t) y) (cons x y))
+  (should (equal (cl--generic-1 'a 'b) '(a . b))))
+
+(ert-deftest cl-generic-test-01-eql ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x y))
+  (cl-defmethod cl--generic-1 ((x t) y) (cons x y))
+  (cl-defmethod cl--generic-1 ((_x (eql 4)) _y)
+    (cons "quatre" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_x (eql 5)) _y)
+    (cons "cinq" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_x (eql 6)) y)
+    (cons "six" (cl-call-next-method 'a y)))
+  (should (equal (cl--generic-1 'a nil) '(a)))
+  (should (equal (cl--generic-1 4 nil) '("quatre" 4)))
+  (should (equal (cl--generic-1 5 nil) '("cinq" 5)))
+  (should (equal (cl--generic-1 6 nil) '("six" a))))
+
+(cl-defstruct cl-generic-struct-parent a b)
+(cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent)) c)
+(cl-defstruct (cl-generic-struct-child11 (:include cl-generic-struct-child1)) d)
+(cl-defstruct (cl-generic-struct-child2 (:include cl-generic-struct-parent)) e)
+
+(ert-deftest cl-generic-test-02-struct ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x y) "My doc.")
+  (cl-defmethod cl--generic-1 ((x t) y) "Doc 1." (cons x y))
+  (cl-defmethod cl--generic-1 ((_x cl-generic-struct-parent) y)
+    "Doc 2." (cons "parent" (cl-call-next-method 'a y)))
+  (cl-defmethod cl--generic-1 ((_x cl-generic-struct-child1) _y)
+    (cons "child1" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 :around ((_x t) _y)
+    (cons "around" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 :around ((_x cl-generic-struct-child11) _y)
+    (cons "child11" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_x cl-generic-struct-child2) _y)
+    (cons "child2" (cl-call-next-method)))
+  (should (equal (cl--generic-1 (make-cl-generic-struct-child1) nil)
+                 '("around" "child1" "parent" a)))
+  (should (equal (cl--generic-1 (make-cl-generic-struct-child2) nil)
+                 '("around""child2" "parent" a)))
+  (should (equal (cl--generic-1 (make-cl-generic-struct-child11) nil)
+                 '("child11" "around""child1" "parent" a))))
+
+;; I don't know how to put this inside an `ert-test'.  This tests that `setf'
+;; can be used directly inside the body of the setf method.
+(cl-defmethod (setf cl--generic-2) (v (y integer) z)
+  (setf (cl--generic-2 (nth y z) z) v))
+
+(ert-deftest cl-generic-test-03-setf ()
+  (cl-defmethod (setf cl--generic-1) (v (y t) z) (list v y z))
+  (cl-defmethod (setf cl--generic-1) (v (_y (eql 4)) z) (list v "four" z))
+  (should (equal (setf (cl--generic-1 'a 'b) 'v) '(v a b)))
+  (should (equal (setf (cl--generic-1 4 'b) 'v) '(v "four" b)))
+  (let ((x ()))
+    (should (equal (setf (cl--generic-1 (progn (push 1 x) 'a)
+                                        (progn (push 2 x) 'b))
+                         (progn (push 3 x) 'v))
+                   '(v a b)))
+    (should (equal x '(3 2 1)))))
+
+(ert-deftest cl-generic-test-04-overlapping-tagcodes ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x y) "My doc.")
+  (cl-defmethod cl--generic-1 ((y t) z) (list y z))
+  (cl-defmethod cl--generic-1 ((_y (eql 4)) _z)
+                (cons "four" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_y integer) _z)
+                (cons "integer" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_y number) _z)
+                (cons "number" (cl-call-next-method)))
+  (should (equal (cl--generic-1 'a 'b) '(a b)))
+  (should (equal (cl--generic-1 1 'b) '("integer" "number" 1 b)))
+  (should (equal (cl--generic-1 4 'b) '("four" "integer" "number" 4 b))))
+
+(ert-deftest cl-generic-test-05-alias ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x y) "My doc.")
+  (defalias 'cl--generic-2 #'cl--generic-1)
+  (cl-defmethod cl--generic-1 ((y t) z) (list y z))
+  (cl-defmethod cl--generic-2 ((_y (eql 4)) _z)
+                (cons "four" (cl-call-next-method)))
+  (should (equal (cl--generic-1 4 'b) '("four" 4 b))))
+
+(ert-deftest cl-generic-test-06-multiple-dispatch ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x y) "My doc.")
+  (cl-defmethod cl--generic-1 (x y) (list x y))
+  (cl-defmethod cl--generic-1 (_x (_y integer))
+    (cons "y-int" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_x integer) _y)
+    (cons "x-int" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_x integer) (_y integer))
+    (cons "x&y-int" (cl-call-next-method)))
+  (should (equal (cl--generic-1 1 2) '("x&y-int" "x-int" "y-int" 1 2))))
+
+(ert-deftest cl-generic-test-07-apo ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x y)
+    (:documentation "My doc.") (:argument-precedence-order y x))
+  (cl-defmethod cl--generic-1 (x y) (list x y))
+  (cl-defmethod cl--generic-1 (_x (_y integer))
+    (cons "y-int" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_x integer) _y)
+    (cons "x-int" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_x integer) (_y integer))
+    (cons "x&y-int" (cl-call-next-method)))
+  (should (equal (cl--generic-1 1 2) '("x&y-int" "y-int" "x-int" 1 2))))
+
+(ert-deftest cl-generic-test-08-after/before ()
+  (let ((log ()))
+    (fmakunbound 'cl--generic-1)
+    (cl-defgeneric cl--generic-1 (x y))
+    (cl-defmethod cl--generic-1 ((_x t) y) (cons y log))
+    (cl-defmethod cl--generic-1 ((_x (eql 4)) _y)
+    (cons "quatre" (cl-call-next-method)))
+    (cl-defmethod cl--generic-1 :after (x _y)
+      (push (list :after x) log))
+    (cl-defmethod cl--generic-1 :before (x _y)
+      (push (list :before x) log))
+    (should (equal (cl--generic-1 4 6) '("quatre" 6 (:before 4))))
+    (should (equal log '((:after 4) (:before 4))))))
+
+(defun cl--generic-test-advice (&rest args) (cons "advice" (apply args)))
+
+(ert-deftest cl-generic-test-09-advice ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x y) "My doc.")
+  (cl-defmethod cl--generic-1 (x y) (list x y))
+  (advice-add 'cl--generic-1 :around #'cl--generic-test-advice)
+  (should (equal (cl--generic-1 4 5) '("advice" 4 5)))
+  (cl-defmethod cl--generic-1 ((_x integer) _y)
+    (cons "integer" (cl-call-next-method)))
+  (should (equal (cl--generic-1 4 5) '("advice" "integer" 4 5)))
+  (advice-remove 'cl--generic-1 #'cl--generic-test-advice)
+  (should (equal (cl--generic-1 4 5) '("integer" 4 5))))
+
+(ert-deftest cl-generic-test-10-weird ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x &rest r) "My doc.")
+  (cl-defmethod cl--generic-1 (x &rest r) (cons x r))
+  ;; This kind of definition is not valid according to CLHS, but it does show
+  ;; up in EIEIO's tests for no-next-method, so we should either
+  ;; detect it and signal an error or do something meaningful with it.
+  (cl-defmethod cl--generic-1 (x (y integer) &rest r)
+    `("integer" ,y ,x ,@r))
+  (should (equal (cl--generic-1 'a 'b) '(a b)))
+  (should (equal (cl--generic-1 1 2) '("integer" 2 1))))
+
+(ert-deftest cl-generic-test-11-next-method-p ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x y))
+  (cl-defmethod cl--generic-1 ((x t) y)
+    (list x y (cl-next-method-p)))
+  (cl-defmethod cl--generic-1 ((_x (eql 4)) _y)
+    (cl-list* "quatre" (cl-next-method-p) (cl-call-next-method)))
+  (should (equal (cl--generic-1 4 5) '("quatre" t 4 5 nil))))
+
+(ert-deftest cl-generic-test-12-context ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 ())
+  (cl-defmethod cl--generic-1 (&context (overwrite-mode (eql t)))
+    (list 'is-t (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 (&context (overwrite-mode (eql nil)))
+    (list 'is-nil (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 () 'any)
+  (should (equal (list (let ((overwrite-mode t))   (cl--generic-1))
+                       (let ((overwrite-mode nil)) (cl--generic-1))
+                       (let ((overwrite-mode 1))   (cl--generic-1)))
+                 '((is-t any) (is-nil any) any))))
+
+(ert-deftest cl-generic-test-13-head ()
+  (fmakunbound 'cl--generic-1)
+  (cl-defgeneric cl--generic-1 (x y))
+  (cl-defmethod cl--generic-1 ((x t) y) (cons x y))
+  (cl-defmethod cl--generic-1 ((_x (head 4)) _y)
+    (cons "quatre" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_x (head 5)) _y)
+    (cons "cinq" (cl-call-next-method)))
+  (cl-defmethod cl--generic-1 ((_x (head 6)) y)
+    (cons "six" (cl-call-next-method 'a y)))
+  (should (equal (cl--generic-1 'a nil) '(a)))
+  (should (equal (cl--generic-1 '(4) nil) '("quatre" (4))))
+  (should (equal (cl--generic-1 '(5) nil) '("cinq" (5))))
+  (should (equal (cl--generic-1 '(6) nil) '("six" a))))
+
+(provide 'cl-generic-tests)
+;;; cl-generic-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
new file mode 100644
index 00000000000..e2429b7de37
--- /dev/null
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -0,0 +1,496 @@
+;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2013-2015 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 'a  nil "" "x" c2)))
+      (should (equal (cl-set-difference b a) (list 'y 'x)))
+
+      ;; 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 'a  nil "" "x" c2)))
+      (should (equal (cl-set-difference b a :test 'eq) (list 'y 'x)))
+
+      (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
+               (:constructor cl-lib--con-1 (&aux (abc 1)))
+               (:constructor cl-lib--con-2 (&optional def) "Constructor docstring."))
+  "General docstring."
+  (abc 5 :readonly t) (def nil))
+(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 (pcase (cl-struct-slot-info 'mystruct)
+              (`((cl-tag-slot) (abc 5 :readonly t)
+                 (def . ,(or `nil `(nil))))
+               t)))))
+(ert-deftest cl-lib-struct-constructors ()
+  (should (string-match "\\`Constructor docstring."
+                        (documentation 'cl-lib--con-2 t)))
+  (should (mystruct-p (cl-lib--con-1)))
+  (should (mystruct-p (cl-lib--con-2))))
+
+(ert-deftest cl-lib-arglist-performance ()
+  ;; An `&aux' should not cause lambda's arglist to be turned into an &rest
+  ;; that's parsed by hand.
+  (should (equal () (help-function-arglist 'cl-lib--con-1)))
+  (should (pcase (help-function-arglist 'cl-lib--con-2)
+            (`(&optional ,_) t))))
+
+(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-lib-test-plusp ()
+  (should-not (cl-plusp -1.0e+INF))
+  (should-not (cl-plusp -1.5e2))
+  (should-not (cl-plusp -3.14))
+  (should-not (cl-plusp -1))
+  (should-not (cl-plusp -0.0))
+  (should-not (cl-plusp 0))
+  (should-not (cl-plusp 0.0))
+  (should-not (cl-plusp -0.0e+NaN))
+  (should-not (cl-plusp 0.0e+NaN))
+  (should (cl-plusp 1))
+  (should (cl-plusp 3.14))
+  (should (cl-plusp 1.5e2))
+  (should (cl-plusp 1.0e+INF))
+  (should-error (cl-plusp "42") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-minusp ()
+  (should (cl-minusp -1.0e+INF))
+  (should (cl-minusp -1.5e2))
+  (should (cl-minusp -3.14))
+  (should (cl-minusp -1))
+  (should-not (cl-minusp -0.0))
+  (should-not (cl-minusp 0))
+  (should-not (cl-minusp 0.0))
+  (should-not (cl-minusp -0.0e+NaN))
+  (should-not (cl-minusp 0.0e+NaN))
+  (should-not (cl-minusp 1))
+  (should-not (cl-minusp 3.14))
+  (should-not (cl-minusp 1.5e2))
+  (should-not (cl-minusp 1.0e+INF))
+  (should-error (cl-minusp "-42") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-oddp ()
+  (should (cl-oddp -3))
+  (should (cl-oddp 3))
+  (should-not (cl-oddp -2))
+  (should-not (cl-oddp 0))
+  (should-not (cl-oddp 2))
+  (should-error (cl-oddp 3.0e+NaN) :type 'wrong-type-argument)
+  (should-error (cl-oddp 3.0) :type 'wrong-type-argument)
+  (should-error (cl-oddp "3") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-evenp ()
+  (should (cl-evenp -2))
+  (should (cl-evenp 0))
+  (should (cl-evenp 2))
+  (should-not (cl-evenp -3))
+  (should-not (cl-evenp 3))
+  (should-error (cl-evenp 2.0e+NaN) :type 'wrong-type-argument)
+  (should-error (cl-evenp 2.0) :type 'wrong-type-argument)
+  (should-error (cl-evenp "2") :type 'wrong-type-argument))
+
+(ert-deftest cl-digit-char-p ()
+  (should (eql 3 (cl-digit-char-p ?3)))
+  (should (eql 10 (cl-digit-char-p ?a 11)))
+  (should (eql 10 (cl-digit-char-p ?A 11)))
+  (should-not (cl-digit-char-p ?a))
+  (should (eql 32 (cl-digit-char-p ?w 36)))
+  (should-error (cl-digit-char-p ?a 37) :type 'args-out-of-range)
+  (should-error (cl-digit-char-p ?a 1) :type 'args-out-of-range))
+
+(ert-deftest cl-lib-test-first ()
+  (should (null (cl-first '())))
+  (should (= 4 (cl-first '(4))))
+  (should (= 4 (cl-first '(4 2))))
+  (should-error (cl-first "42") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-second ()
+  (should (null (cl-second '())))
+  (should (null (cl-second '(4))))
+  (should (= 2 (cl-second '(1 2))))
+  (should (= 2 (cl-second '(1 2 3))))
+  (should-error (cl-second "1 2 3") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-third ()
+  (should (null (cl-third '())))
+  (should (null (cl-third '(1 2))))
+  (should (= 3 (cl-third '(1 2 3))))
+  (should (= 3 (cl-third '(1 2 3 4))))
+  (should-error (cl-third "123") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-fourth ()
+  (should (null (cl-fourth '())))
+  (should (null (cl-fourth '(1 2 3))))
+  (should (= 4 (cl-fourth '(1 2 3 4))))
+  (should (= 4 (cl-fourth '(1 2 3 4 5))))
+  (should-error (cl-fourth "1234") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-fifth ()
+  (should (null (cl-fifth '())))
+  (should (null (cl-fifth '(1 2 3 4))))
+  (should (= 5 (cl-fifth '(1 2 3 4 5))))
+  (should (= 5 (cl-fifth '(1 2 3 4 5 6))))
+  (should-error (cl-fifth "12345") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-fifth ()
+  (should (null (cl-fifth '())))
+  (should (null (cl-fifth '(1 2 3 4))))
+  (should (= 5 (cl-fifth '(1 2 3 4 5))))
+  (should (= 5 (cl-fifth '(1 2 3 4 5 6))))
+  (should-error (cl-fifth "12345") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-sixth ()
+  (should (null (cl-sixth '())))
+  (should (null (cl-sixth '(1 2 3 4 5))))
+  (should (= 6 (cl-sixth '(1 2 3 4 5 6))))
+  (should (= 6 (cl-sixth '(1 2 3 4 5 6 7))))
+  (should-error (cl-sixth "123456") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-seventh ()
+  (should (null (cl-seventh '())))
+  (should (null (cl-seventh '(1 2 3 4 5 6))))
+  (should (= 7 (cl-seventh '(1 2 3 4 5 6 7))))
+  (should (= 7 (cl-seventh '(1 2 3 4 5 6 7 8))))
+  (should-error (cl-seventh "1234567") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-eighth ()
+  (should (null (cl-eighth '())))
+  (should (null (cl-eighth '(1 2 3 4 5 6 7))))
+  (should (= 8 (cl-eighth '(1 2 3 4 5 6 7 8))))
+  (should (= 8 (cl-eighth '(1 2 3 4 5 6 7 8 9))))
+  (should-error (cl-eighth "12345678") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-ninth ()
+  (should (null (cl-ninth '())))
+  (should (null (cl-ninth '(1 2 3 4 5 6 7 8))))
+  (should (= 9 (cl-ninth '(1 2 3 4 5 6 7 8 9))))
+  (should (= 9 (cl-ninth '(1 2 3 4 5 6 7 8 9 10))))
+  (should-error (cl-ninth "123456789") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-tenth ()
+  (should (null (cl-tenth '())))
+  (should (null (cl-tenth '(1 2 3 4 5 6 7 8 9))))
+  (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10))))
+  (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10 11))))
+  (should-error (cl-tenth "1234567890") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-endp ()
+  (should (cl-endp '()))
+  (should-not (cl-endp '(1)))
+  (should-error (cl-endp 1) :type 'wrong-type-argument)
+  (should-error (cl-endp [1]) :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-nth-value ()
+  (let ((vals (cl-values 2 3)))
+    (should (= (cl-nth-value 0 vals) 2))
+    (should (= (cl-nth-value 1 vals) 3))
+    (should (null (cl-nth-value 2 vals)))
+    (should-error (cl-nth-value 0.0 vals) :type 'wrong-type-argument)))
+
+(ert-deftest cl-lib-nth-value-test-multiple-values ()
+  "While CL multiple values are an alias to list, these won't work."
+  :expected-result :failed
+  (should (eq (cl-nth-value 0 '(2 3)) '(2 3)))
+  (should (= (cl-nth-value 0 1) 1))
+  (should (null (cl-nth-value 1 1)))
+  (should-error (cl-nth-value -1 (cl-values 2 3)) :type 'args-out-of-range)
+  (should (string= (cl-nth-value 0 "only lists") "only lists")))
+
+(ert-deftest cl-test-caaar ()
+  (should (null (cl-caaar '())))
+  (should (null (cl-caaar '(() (2)))))
+  (should (null (cl-caaar '((() (2)) (a b)))))
+  (should-error (cl-caaar '(1 2)) :type 'wrong-type-argument)
+  (should-error (cl-caaar '((1 2))) :type 'wrong-type-argument)
+  (should (=  1 (cl-caaar '(((1 2) (3 4))))))
+  (should (null (cl-caaar '((() (3 4)))))))
+
+(ert-deftest cl-test-caadr ()
+  (should (null (cl-caadr '())))
+  (should (null (cl-caadr '(1))))
+  (should-error (cl-caadr '(1 2)) :type 'wrong-type-argument)
+  (should (= 2 (cl-caadr '(1 (2 3)))))
+  (should (equal '((2) (3)) (cl-caadr '((1) (((2) (3))) (4))))))
+
+(ert-deftest cl-test-ldiff ()
+  (let ((l '(1 2 3)))
+    (should (null (cl-ldiff '() '())))
+    (should (null (cl-ldiff '() l)))
+    (should (null (cl-ldiff l l)))
+    (should (equal l (cl-ldiff l '())))
+    ;; must be part of the list
+    (should (equal l (cl-ldiff l '(2 3))))
+    (should (equal '(1) (cl-ldiff l (nthcdr 1 l))))
+    ;; should return a copy
+    (should-not (eq (cl-ldiff l '()) l))))
+
+(ert-deftest cl-lib-adjoin-test ()
+  (let ((nums '(1 2))
+        (myfn-p '=))
+    ;; add non-existing item to the front
+    (should (equal '(3 1 2) (cl-adjoin 3 nums)))
+    ;; just add - don't copy rest
+    (should (eq nums (cdr (cl-adjoin 3 nums))))
+    ;; add only when not already there
+    (should (eq nums (cl-adjoin 2 nums)))
+    (should (equal '(2 1 (2)) (cl-adjoin 2 '(1 (2)))))
+    ;; default test function is eql
+    (should (equal '(1.0 1 2) (cl-adjoin 1.0 nums)))
+    ;; own :test function - returns true if match
+    (should (equal '(1.0 1 2) (cl-adjoin 1.0 nums :test nil))) ;defaults to eql
+    (should (eq nums (cl-adjoin 2 nums :test myfn-p))) ;match
+    (should (equal '(3 1 2) (cl-adjoin 3 nums :test myfn-p))) ;no match
+    ;; own :test-not function - returns false if match
+    (should (equal '(1.0 1 2) (cl-adjoin 1.0 nums :test-not nil))) ;defaults to eql
+    (should (equal '(2 2) (cl-adjoin 2 '(2) :test-not myfn-p))) ; no match
+    (should (eq nums (cl-adjoin 2 nums :test-not myfn-p))) ; 1 matches
+    (should (eq nums (cl-adjoin 3 nums :test-not myfn-p))) ; 1 and 2 matches
+
+    ;; according to CLtL2 passing both :test and :test-not should signal error
+    ;;(should-error (cl-adjoin 3 nums :test 'myfn-p :test-not myfn-p))
+
+    ;; own :key fn
+    (should (eq nums (cl-adjoin 3 nums :key (lambda (x) (if (cl-evenp x) (1+ x) x)))))
+    (should (equal '(3 1 2) (cl-adjoin 3 nums :key (lambda (x) (if (cl-evenp x) (+ 2 x) x)))))
+
+    ;; convert using :key, then compare with :test
+    (should (eq nums (cl-adjoin 1 nums :key 'int-to-string :test 'string=)))
+    (should (equal '(3 1 2) (cl-adjoin 3 nums :key 'int-to-string :test 'string=)))
+    (should-error (cl-adjoin 3 nums :key 'int-to-string :test myfn-p)
+                  :type 'wrong-type-argument)
+
+    ;; convert using :key, then compare with :test-not
+    (should (eq nums (cl-adjoin 3 nums :key 'int-to-string :test-not 'string=)))
+    (should (equal '(1 1) (cl-adjoin 1 '(1) :key 'int-to-string :test-not 'string=)))
+    (should-error (cl-adjoin 1 nums :key 'int-to-string :test-not myfn-p)
+                  :type 'wrong-type-argument)))
+
+(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)))
+
+(ert-deftest cl-flet-test ()
+  (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5)))
+
+(ert-deftest cl-lib-test-typep ()
+  (cl-deftype cl-lib-test-type (&optional x) `(member ,x))
+  ;; Make sure we correctly implement the rule that deftype's optional args
+  ;; default to `*' rather than to nil.
+  (should (cl-typep '* 'cl-lib-test-type))
+  (should-not (cl-typep 1 'cl-lib-test-type)))
+
+;;; cl-lib.el ends here
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
new file mode 100644
index 00000000000..557f031d181
--- /dev/null
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
@@ -0,0 +1,402 @@
+;;; eieio-testsinvoke.el -- eieio tests for method invocation
+
+;; Copyright (C) 2005, 2008, 2010, 2013-2015 Free Software Foundation,
+;; Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Test method invocation order.  From the common lisp reference
+;; manual:
+;;
+;; QUOTE:
+;; - All the :before methods are called, in most-specific-first
+;;   order.  Their values are ignored.  An error is signaled if
+;;   call-next-method is used in a :before method.
+;;
+;; - The most specific primary method is called. Inside the body of a
+;;   primary method, call-next-method may be used to call the next
+;;   most specific primary method. When that method returns, the
+;;   previous primary method can execute more code, perhaps based on
+;;   the returned value or values. The generic function no-next-method
+;;   is invoked if call-next-method is used and there are no more
+;;   applicable primary methods. The function next-method-p may be
+;;   used to determine whether a next method exists. If
+;;   call-next-method is not used, only the most specific primary
+;;   method is called.
+;;
+;; - All the :after methods are called, in most-specific-last order.
+;;   Their values are ignored.  An error is signaled if
+;;   call-next-method is used in a :after method.
+;;
+;;
+;; Also test behavior of `call-next-method'. From clos.org:
+;;
+;; QUOTE:
+;; When call-next-method is called with no arguments, it passes the
+;; current method's original arguments to the next method.
+
+(require 'eieio)
+(require 'ert)
+
+(defvar eieio-test-method-order-list nil
+  "List of symbols stored during method invocation.")
+
+(defun eieio-test-method-store (&rest args)
+  "Store current invocation class symbol in the invocation order list."
+  (push args eieio-test-method-order-list))
+
+(defun eieio-test-match (rightanswer)
+  "Do a test match."
+  (if (equal rightanswer eieio-test-method-order-list)
+      t
+    (error "eieio-test-methodinvoke.el: Test Failed: %S != %S"
+           rightanswer eieio-test-method-order-list)))
+
+(defvar eieio-test-call-next-method-arguments nil
+  "List of passed to methods during execution of `call-next-method'.")
+
+(defun eieio-test-arguments-for (class)
+  "Returns arguments passed to method of CLASS during `call-next-method'."
+  (cdr (assoc class eieio-test-call-next-method-arguments)))
+
+(defclass eitest-A () ())
+(defclass eitest-AA (eitest-A) ())
+(defclass eitest-AAA (eitest-AA) ())
+(defclass eitest-B-base1 () ())
+(defclass eitest-B-base2 () ())
+(defclass eitest-B (eitest-B-base1 eitest-B-base2) ())
+
+(defmethod eitest-F :BEFORE ((p eitest-B-base1))
+  (eieio-test-method-store :BEFORE 'eitest-B-base1))
+
+(defmethod eitest-F :BEFORE ((p eitest-B-base2))
+  (eieio-test-method-store :BEFORE 'eitest-B-base2))
+
+(defmethod eitest-F :BEFORE ((p eitest-B))
+  (eieio-test-method-store :BEFORE 'eitest-B))
+
+(defmethod eitest-F ((p eitest-B))
+  (eieio-test-method-store :PRIMARY 'eitest-B)
+  (call-next-method))
+
+(defmethod eitest-F ((p eitest-B-base1))
+  (eieio-test-method-store :PRIMARY 'eitest-B-base1)
+  (call-next-method))
+
+(defmethod eitest-F ((p eitest-B-base2))
+  (eieio-test-method-store :PRIMARY 'eitest-B-base2)
+  (when (next-method-p)
+    (call-next-method))
+  )
+
+(defmethod eitest-F :AFTER ((p eitest-B-base1))
+  (eieio-test-method-store :AFTER 'eitest-B-base1))
+
+(defmethod eitest-F :AFTER ((p eitest-B-base2))
+  (eieio-test-method-store :AFTER 'eitest-B-base2))
+
+(defmethod eitest-F :AFTER ((p eitest-B))
+  (eieio-test-method-store :AFTER 'eitest-B))
+
+(ert-deftest eieio-test-method-order-list-3 ()
+  (let ((eieio-test-method-order-list nil)
+	(ans '(
+	       (:BEFORE eitest-B)
+	       (:BEFORE eitest-B-base1)
+	       (:BEFORE eitest-B-base2)
+
+	       (:PRIMARY eitest-B)
+	       (:PRIMARY eitest-B-base1)
+	       (:PRIMARY eitest-B-base2)
+
+	       (:AFTER eitest-B-base2)
+	       (:AFTER eitest-B-base1)
+	       (:AFTER eitest-B)
+	       )))
+    (eitest-F (eitest-B nil))
+    (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
+    (eieio-test-match ans)))
+
+;;; Test static invocation
+;;
+(defmethod eitest-H :STATIC ((class eitest-A))
+  "No need to do work in here."
+  'moose)
+
+(ert-deftest eieio-test-method-order-list-4 ()
+  ;; Both of these situations should succeed.
+  (should (eitest-H 'eitest-A))
+  (should (eitest-H (eitest-A nil))))
+
+;;; Return value from :PRIMARY
+;;
+(defmethod eitest-I :BEFORE ((a eitest-A))
+  (eieio-test-method-store :BEFORE 'eitest-A)
+  ":before")
+
+(defmethod eitest-I :PRIMARY ((a eitest-A))
+  (eieio-test-method-store :PRIMARY 'eitest-A)
+  ":primary")
+
+(defmethod eitest-I :AFTER ((a eitest-A))
+  (eieio-test-method-store :AFTER 'eitest-A)
+  ":after")
+
+(ert-deftest eieio-test-method-order-list-5 ()
+  (let ((eieio-test-method-order-list nil)
+	(ans  (eitest-I (eitest-A nil))))
+    (should (string= ans ":primary"))))
+
+;;; Multiple inheritance and the 'constructor' method.
+;;
+;; Constructor is a static method, so this is really testing
+;; static method invocation and multiple inheritance.
+;;
+(defclass C-base1 () ())
+(defclass C-base2 () ())
+(defclass C (C-base1 C-base2) ())
+
+;; Just use the obsolete name once, to make sure it also works.
+(defmethod constructor :STATIC ((p C-base1) &rest args)
+  (eieio-test-method-store :STATIC 'C-base1)
+  (if (next-method-p) (call-next-method))
+  )
+
+(defmethod make-instance :STATIC ((p C-base2) &rest args)
+  (eieio-test-method-store :STATIC 'C-base2)
+  (if (next-method-p) (call-next-method))
+  )
+
+(cl-defmethod make-instance ((p (subclass C)) &rest args)
+  (eieio-test-method-store :STATIC 'C)
+  (cl-call-next-method)
+  )
+
+(ert-deftest eieio-test-method-order-list-6 ()
+  (let ((eieio-test-method-order-list nil)
+	(ans '(
+	       (:STATIC C)
+	       (:STATIC C-base1)
+	       (:STATIC C-base2)
+	       )))
+    (C nil)
+    (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
+    (eieio-test-match ans)))
+
+;;; Diamond Test
+;;
+;; For a diamond shaped inheritance structure, (call-next-method) can break.
+;; As such, there are two possible orders.
+
+(defclass D-base0 () () :method-invocation-order :depth-first)
+(defclass D-base1 (D-base0) () :method-invocation-order :depth-first)
+(defclass D-base2 (D-base0) () :method-invocation-order :depth-first)
+(defclass D (D-base1 D-base2) () :method-invocation-order :depth-first)
+
+(defmethod eitest-F ((p D))
+  "D"
+  (eieio-test-method-store :PRIMARY 'D)
+  (call-next-method))
+
+(defmethod eitest-F ((p D-base0))
+  "D-base0"
+  (eieio-test-method-store :PRIMARY 'D-base0)
+  ;; This should have no next
+  ;; (when (next-method-p) (call-next-method))
+  )
+
+(defmethod eitest-F ((p D-base1))
+  "D-base1"
+  (eieio-test-method-store :PRIMARY 'D-base1)
+  (call-next-method))
+
+(defmethod eitest-F ((p D-base2))
+  "D-base2"
+  (eieio-test-method-store :PRIMARY 'D-base2)
+  (when (next-method-p)
+    (call-next-method))
+  )
+
+(ert-deftest eieio-test-method-order-list-7 ()
+  (let ((eieio-test-method-order-list nil)
+	(ans '(
+	       (:PRIMARY D)
+	       (:PRIMARY D-base1)
+	       ;; (:PRIMARY D-base2)
+	       (:PRIMARY D-base0)
+	       )))
+    (eitest-F (D nil))
+    (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
+    (eieio-test-match ans)))
+
+;;; Other invocation order
+
+(defclass E-base0 () () :method-invocation-order :breadth-first)
+(defclass E-base1 (E-base0) () :method-invocation-order :breadth-first)
+(defclass E-base2 (E-base0) () :method-invocation-order :breadth-first)
+(defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first)
+
+(defmethod eitest-F ((p E))
+  (eieio-test-method-store :PRIMARY 'E)
+  (call-next-method))
+
+(defmethod eitest-F ((p E-base0))
+  (eieio-test-method-store :PRIMARY 'E-base0)
+  ;; This should have no next
+  ;; (when (next-method-p) (call-next-method))
+  )
+
+(defmethod eitest-F ((p E-base1))
+  (eieio-test-method-store :PRIMARY 'E-base1)
+  (call-next-method))
+
+(defmethod eitest-F ((p E-base2))
+  (eieio-test-method-store :PRIMARY 'E-base2)
+  (when (next-method-p)
+    (call-next-method))
+  )
+
+(ert-deftest eieio-test-method-order-list-8 ()
+  (let ((eieio-test-method-order-list nil)
+	(ans '(
+	       (:PRIMARY E)
+	       (:PRIMARY E-base1)
+	       (:PRIMARY E-base2)
+	       (:PRIMARY E-base0)
+	       )))
+    (eitest-F (E nil))
+    (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list))
+    (eieio-test-match ans)))
+
+;;; Jan's methodinvoke order w/ multiple inheritance and :after methods.
+;;
+(defclass eitest-Ja ()
+  ())
+
+(defmethod initialize-instance :after ((this eitest-Ja) &rest slots)
+  ;(message "+Ja")
+  ;; FIXME: Using next-method-p in an after-method is invalid!
+  (when (next-method-p)
+    (call-next-method))
+  ;(message "-Ja")
+  )
+
+(defclass eitest-Jb ()
+  ())
+
+(defmethod initialize-instance :after ((this eitest-Jb) &rest slots)
+  ;(message "+Jb")
+  ;; FIXME: Using next-method-p in an after-method is invalid!
+  (when (next-method-p)
+    (call-next-method))
+  ;(message "-Jb")
+  )
+
+(defclass eitest-Jc (eitest-Jb)
+  ())
+
+(defclass eitest-Jd (eitest-Jc eitest-Ja)
+  ())
+
+(defmethod initialize-instance ((this eitest-Jd) &rest slots)
+  ;(message "+Jd")
+  (when (next-method-p)
+    (call-next-method))
+  ;(message "-Jd")
+  )
+
+(ert-deftest eieio-test-method-order-list-9 ()
+  (should (eitest-Jd "test")))
+
+;;; call-next-method with replacement arguments across a simple class hierarchy.
+;;
+
+(defclass CNM-0 ()
+  ())
+
+(defclass CNM-1-1 (CNM-0)
+  ())
+
+(defclass CNM-1-2 (CNM-0)
+  ())
+
+(defclass CNM-2 (CNM-1-1 CNM-1-2)
+  ())
+
+(defmethod CNM-M ((this CNM-0) args)
+  (push (cons 'CNM-0 (copy-sequence args))
+	eieio-test-call-next-method-arguments)
+  (when (next-method-p)
+    (call-next-method
+     this (cons 'CNM-0 args))))
+
+(defmethod CNM-M ((this CNM-1-1) args)
+  (push (cons 'CNM-1-1 (copy-sequence args))
+	eieio-test-call-next-method-arguments)
+  (when (next-method-p)
+    (call-next-method
+     this (cons 'CNM-1-1 args))))
+
+(defmethod CNM-M ((this CNM-1-2) args)
+  (push (cons 'CNM-1-2 (copy-sequence args))
+	eieio-test-call-next-method-arguments)
+  (when (next-method-p)
+    (call-next-method)))
+
+(defmethod CNM-M ((this CNM-2) args)
+  (push (cons 'CNM-2 (copy-sequence args))
+	eieio-test-call-next-method-arguments)
+  (when (next-method-p)
+    (call-next-method
+     this (cons 'CNM-2 args))))
+
+(ert-deftest eieio-test-method-order-list-10 ()
+  (let ((eieio-test-call-next-method-arguments nil))
+    (CNM-M (CNM-2 "") '(INIT))
+    (should (equal (eieio-test-arguments-for 'CNM-0)
+		   '(CNM-1-1 CNM-2 INIT)))
+    (should (equal (eieio-test-arguments-for 'CNM-1-1)
+		   '(CNM-2 INIT)))
+    (should (equal (eieio-test-arguments-for 'CNM-1-2)
+		   '(CNM-1-1 CNM-2 INIT)))
+    (should (equal (eieio-test-arguments-for 'CNM-2)
+		   '(INIT)))))
+
+;;; Check cl-generic integration.
+
+(cl-defgeneric eieio-test--1 (x y))
+
+(ert-deftest eieio-test-cl-generic-1 ()
+  (cl-defgeneric eieio-test--1 (x y))
+  (cl-defmethod eieio-test--1 (x y) (list x y))
+  (cl-defmethod eieio-test--1 ((_x CNM-0) y)
+    (cons "CNM-0" (cl-call-next-method 7 y)))
+  (cl-defmethod eieio-test--1 ((_x CNM-1-1) _y)
+    (cons "CNM-1-1" (cl-call-next-method)))
+  (cl-defmethod eieio-test--1 ((_x CNM-1-2) _y)
+    (cons "CNM-1-2" (cl-call-next-method)))
+  (cl-defmethod eieio-test--1 ((_x (subclass CNM-1-2)) _y)
+    (cons "subclass CNM-1-2" (cl-call-next-method)))
+  (should (equal (eieio-test--1 4 5) '(4 5)))
+  (should (equal (eieio-test--1 (make-instance 'CNM-0) 5)
+                 '("CNM-0" 7 5)))
+  (should (equal (eieio-test--1 (make-instance 'CNM-2) 5)
+                 '("CNM-1-1" "CNM-1-2" "CNM-0" 7 5)))
+  (should (equal (eieio-test--1 'CNM-2 6) '("subclass CNM-1-2" CNM-2 6))))
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
new file mode 100644
index 00000000000..9b21b730385
--- /dev/null
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
@@ -0,0 +1,219 @@
+;;; eieio-persist.el --- Tests for eieio-persistent class
+
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <eric@siege-engine.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; The eieio-persistent base-class provides a vital service, that
+;; could be used to accidentally load in malicious code.  As such,
+;; something as simple as calling eval on the generated code can't be
+;; used.  These tests exercises various flavors of data that might be
+;; in a persistent object, and tries to save/load them.
+
+;;; Code:
+(require 'eieio)
+(require 'eieio-base)
+(require 'ert)
+
+(defun eieio--attribute-to-initarg (class attribute)
+  "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag.
+This is usually a symbol that starts with `:'."
+  (let ((tuple (rassoc attribute (eieio--class-initarg-tuples class))))
+    (if tuple
+	(car tuple)
+      nil)))
+
+(defun persist-test-save-and-compare (original)
+  "Compare the object ORIGINAL against the one read fromdisk."
+
+  (eieio-persistent-save original)
+
+  (let* ((file (oref original file))
+	 (class (eieio-object-class original))
+	 (fromdisk (eieio-persistent-read file class))
+	 (cv (cl--find-class class))
+	 (slots  (eieio--class-slots cv))
+	 )
+    (unless (object-of-class-p fromdisk class)
+      (error "Persistent class %S != original class %S"
+	     (eieio-object-class fromdisk)
+	     class))
+
+    (dotimes (i (length slots))
+      (let* ((slot (aref slots i))
+             (oneslot (cl--slot-descriptor-name slot))
+	     (origvalue (eieio-oref original oneslot))
+	     (fromdiskvalue (eieio-oref fromdisk oneslot))
+	     (initarg-p (eieio--attribute-to-initarg
+                         (cl--find-class class) oneslot))
+	     )
+
+	(if initarg-p
+	    (unless (equal origvalue fromdiskvalue)
+	      (error "Slot %S Original Val %S != Persistent Val %S"
+		     oneslot origvalue fromdiskvalue))
+	  ;; Else !initarg-p
+	  (unless (equal (cl--slot-descriptor-initform slot) fromdiskvalue)
+	    (error "Slot %S Persistent Val %S != Default Value %S"
+		   oneslot fromdiskvalue (cl--slot-descriptor-initform slot))))
+	))))
+
+;;; Simple Case
+;;
+;; Simplest case is a mix of slots with and without initargs.
+
+(defclass persist-simple (eieio-persistent)
+  ((slot1 :initarg :slot1
+	  :type symbol
+	  :initform moose)
+   (slot2 :initarg :slot2
+	  :initform "foo")
+   (slot3 :initform 2))
+  "A Persistent object with two initializable slots, and one not.")
+
+(ert-deftest eieio-test-persist-simple-1 ()
+  (let ((persist-simple-1
+	 (persist-simple "simple 1" :slot1 'goose :slot2 "testing"
+			 :file (concat default-directory "test-ps1.pt"))))
+    (should persist-simple-1)
+
+    ;; When the slot w/out an initarg has not been changed
+    (persist-test-save-and-compare persist-simple-1)
+
+    ;; When the slot w/out an initarg HAS been changed
+    (oset persist-simple-1 slot3 3)
+    (persist-test-save-and-compare persist-simple-1)
+    (delete-file (oref persist-simple-1 file))))
+
+;;; Slot Writers
+;;
+;; Replica of the test in eieio-tests.el - 
+
+(defclass persist-:printer (eieio-persistent)
+  ((slot1 :initarg :slot1
+	  :initform 'moose
+	  :printer PO-slot1-printer)
+   (slot2 :initarg :slot2
+	  :initform "foo"))
+  "A Persistent object with two initializable slots.")
+
+(defun PO-slot1-printer (slotvalue)
+  "Print the slot value SLOTVALUE to stdout.
+Assume SLOTVALUE is a symbol of some sort."
+  (princ "'")
+  (princ (symbol-name slotvalue))
+  (princ " ;; RAN PRINTER")
+  nil)
+
+(ert-deftest eieio-test-persist-printer ()
+  (let ((persist-:printer-1
+	 (persist-:printer "persist" :slot1 'goose :slot2 "testing"
+			   :file (concat default-directory "test-ps2.pt"))))
+    (should persist-:printer-1)
+    (persist-test-save-and-compare persist-:printer-1)
+
+    (let* ((find-file-hook nil)
+	   (tbuff (find-file-noselect "test-ps2.pt"))
+	   )
+      (condition-case nil
+	  (unwind-protect
+	      (with-current-buffer tbuff
+		(goto-char (point-min))
+		(re-search-forward "RAN PRINTER"))
+	    (kill-buffer tbuff))
+	(error "persist-:printer-1's Slot1 printer function didn't work.")))
+    (delete-file (oref persist-:printer-1 file))))
+
+;;; Slot with Object
+;;
+;; A slot that contains another object that isn't persistent
+(defclass persist-not-persistent ()
+  ((slot1 :initarg :slot1
+	  :initform 1)
+   (slot2 :initform 2))
+  "Class for testing persistent saving of an object that isn't
+persistent.  This class is instead used as a slot value in a
+persistent class.")
+
+(defclass persistent-with-objs-slot (eieio-persistent)
+  ((pnp :initarg :pnp
+	:type (or null persist-not-persistent)
+	:initform nil))
+  "Class for testing the saving of slots with objects in them.")
+
+(ert-deftest eieio-test-non-persistent-as-slot ()
+  (let ((persist-wos
+	 (persistent-with-objs-slot
+	  "persist wos 1"
+	  :pnp (persist-not-persistent "pnp 1" :slot1 3)
+	  :file (concat default-directory "test-ps3.pt"))))
+					     
+    (persist-test-save-and-compare persist-wos)
+    (delete-file (oref persist-wos file))))
+
+;;; Slot with Object child of :type
+;;
+;; A slot that contains another object that isn't persistent
+(defclass persist-not-persistent-subclass (persist-not-persistent)
+  ((slot3 :initarg :slot1
+	  :initform 1)
+   (slot4 :initform 2))
+  "Class for testing persistent saving of an object subclass that isn't
+persistent.  This class is instead used as a slot value in a
+persistent class.")
+
+(defclass persistent-with-objs-slot-subs (eieio-persistent)
+  ((pnp :initarg :pnp
+	:type (or null persist-not-persistent)
+	:initform nil))
+  "Class for testing the saving of slots with objects in them.")
+
+(ert-deftest eieio-test-non-persistent-as-slot-child ()
+  (let ((persist-woss
+	 (persistent-with-objs-slot-subs 
+	  "persist woss 1"
+	  :pnp (persist-not-persistent-subclass "pnps 1" :slot1 3)
+	  :file (concat default-directory "test-ps4.pt"))))
+					     
+    (persist-test-save-and-compare persist-woss)
+    (delete-file (oref persist-woss file))))
+
+;;; Slot with a list of Objects
+;;
+;; A slot that contains another object that isn't persistent
+(defclass persistent-with-objs-list-slot (eieio-persistent)
+  ((pnp :initarg :pnp
+	:type (list-of persist-not-persistent)
+	:initform nil))
+  "Class for testing the saving of slots with objects in them.")
+
+(ert-deftest eieio-test-slot-with-list-of-objects ()
+  (let ((persist-wols
+	 (persistent-with-objs-list-slot 
+	  "persist wols 1"
+	  :pnp (list (persist-not-persistent "pnp 1" :slot1 3)
+		     (persist-not-persistent "pnp 2" :slot1 4)
+		     (persist-not-persistent "pnp 3" :slot1 5))
+	  :file (concat default-directory "test-ps5.pt"))))
+					     
+    (persist-test-save-and-compare persist-wols)
+    (delete-file (oref persist-wols file))))
+
+;;; eieio-test-persist.el ends here
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
new file mode 100644
index 00000000000..915532b299c
--- /dev/null
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -0,0 +1,900 @@
+;;; eieio-tests.el -- eieio tests routines
+
+;; Copyright (C) 1999-2003, 2005-2010, 2012-2015 Free Software
+;; Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Test the various features of EIEIO.
+
+(require 'ert)
+(require 'eieio)
+(require 'eieio-base)
+(require 'eieio-opt)
+
+(eval-when-compile (require 'cl-lib))
+
+;;; Code:
+;; Set up some test classes
+(defclass class-a ()
+  ((water :initarg :water
+	  :initform h20
+	  :type symbol
+	  :documentation "Detail about water.")
+   (classslot :initform penguin
+	      :type symbol
+	      :documentation "A class allocated slot."
+	      :allocation :class)
+   (test-tag :initform nil
+	     :documentation "Used to make sure methods are called.")
+   (self :initform nil
+	 :type (or null class-a)
+	 :documentation "Test self referencing types.")
+   )
+  "Class A")
+
+(defclass class-b ()
+  ((land :initform "Sc"
+	 :type string
+	 :documentation "Detail about land."))
+  "Class B")
+
+(defclass class-ab (class-a class-b)
+  ((amphibian :initform "frog"
+	      :documentation "Detail about amphibian on land and water."))
+  "Class A and B combined.")
+
+(defclass class-c ()
+  ((slot-1 :initarg :moose
+	   :initform moose
+	   :type symbol
+	   :allocation :instance
+	   :documentation "First slot testing slot arguments."
+	   :custom symbol
+	   :label "Wild Animal"
+	   :group borg
+	   :protection :public)
+   (slot-2 :initarg :penguin
+	   :initform "penguin"
+	   :type string
+	   :allocation :instance
+	   :documentation "Second slot testing slot arguments."
+	   :custom string
+	   :label "Wild bird"
+	   :group vorlon
+	   :accessor get-slot-2
+	   :protection :private)
+   (slot-3 :initarg :emu
+	   :initform emu
+	   :type symbol
+	   :allocation :class
+	   :documentation "Third slot test class allocated accessor"
+	   :custom symbol
+	   :label "Fuzz"
+	   :group tokra
+	   :accessor get-slot-3
+	   :protection :private)
+   )
+  (:custom-groups (foo))
+  "A class for testing slot arguments."
+  )
+
+(defclass class-subc (class-c)
+  ((slot-1 ;; :initform moose  - don't override this
+    )
+   (slot-2 :initform "linux" ;; Do override this one
+	   :protection :private
+	   ))
+  "A class for testing slot arguments.")
+
+;;; Defining a class with a slot tag error
+;;
+;; Temporarily disable this test because of macro expansion changes in
+;; current Emacs trunk. It can be re-enabled when we have moved
+;; `eieio-defclass' into the `defclass' macro and the
+;; `eval-and-compile' there is removed.
+
+;; (let ((eieio-error-unsupported-class-tags t))
+;;   (condition-case nil
+;;       (progn
+;; 	(defclass class-error ()
+;; 	  ((error-slot :initarg :error-slot
+;; 		       :badslottag 1))
+;; 	  "A class with a bad slot tag.")
+;; 	(error "No error was thrown for badslottag"))
+;;     (invalid-slot-type nil)))
+
+;; (let ((eieio-error-unsupported-class-tags nil))
+;;   (condition-case nil
+;;       (progn
+;; 	(defclass class-error ()
+;; 	  ((error-slot :initarg :error-slot
+;; 		       :badslottag 1))
+;; 	  "A class with a bad slot tag."))
+;;     (invalid-slot-type
+;;      (error "invalid-slot-type thrown when eieio-error-unsupported-class-tags is nil")
+;;      )))
+
+(ert-deftest eieio-test-01-mix-alloc-initarg ()
+  ;; Only run this test if the message framework thingy works.
+  (when (and (message "foo") (string= "foo" (current-message)))
+
+    ;; Defining this class should generate a warning(!) message that
+    ;; you should not mix :initarg with class allocated slots.
+    (defclass class-alloc-initarg ()
+      ((throwwarning :initarg :throwwarning
+		     :allocation :class))
+      "Throw a warning mixing allocation class and an initarg.")
+
+    ;; Check that message is there
+    (should (current-message))
+    (should (string-match "Class allocated slots do not need :initarg"
+			  (current-message)))))
+
+(defclass abstract-class ()
+  ((some-slot :initarg :some-slot
+	      :initform nil
+	      :documentation "A slot."))
+  :documentation "An abstract class."
+  :abstract t)
+
+(ert-deftest eieio-test-02-abstract-class ()
+  ;; Abstract classes cannot be instantiated, so this should throw an
+  ;; error
+  (should-error (abstract-class)))
+
+(defgeneric generic1 () "First generic function")
+
+(ert-deftest eieio-test-03-generics ()
+  (defun anormalfunction () "A plain function for error testing." nil)
+  (should-error
+   (progn
+     (defgeneric anormalfunction ()
+       "Attempt to turn it into a generic.")))
+
+  ;; Check that generic-p works
+  (should (generic-p 'generic1))
+
+  (defmethod generic1 ((c class-a))
+    "Method on generic1."
+    'monkey)
+
+  (defmethod generic1 (not-an-object)
+    "Method generic1 that can take a non-object."
+    not-an-object)
+
+  (let ((ans-obj (generic1 (class-a)))
+	(ans-num (generic1 666)))
+    (should (eq ans-obj 'monkey))
+    (should (eq ans-num 666))))
+
+(defclass static-method-class ()
+  ((some-slot :initform nil
+	      :allocation :class
+	      :documentation "A slot."))
+  :documentation "A class used for testing static methods.")
+
+(defmethod static-method-class-method :STATIC ((c static-method-class) value)
+  "Test static methods.
+Argument C is the class bound to this static method."
+  (if (eieio-object-p c) (setq c (eieio-object-class c)))
+  (oset-default c some-slot value))
+
+(ert-deftest eieio-test-04-static-method ()
+  ;; Call static method on a class and see if it worked
+  (static-method-class-method 'static-method-class 'class)
+  (should (eq (oref-default 'static-method-class some-slot) 'class))
+  (static-method-class-method (static-method-class) 'object)
+  (should (eq (oref-default 'static-method-class some-slot) 'object)))
+
+(ert-deftest eieio-test-05-static-method-2 ()
+  (defclass static-method-class-2 (static-method-class)
+    ()
+    "A second class after the previous for static methods.")
+
+  (defmethod static-method-class-method :STATIC ((c static-method-class-2) value)
+    "Test static methods.
+Argument C is the class bound to this static method."
+    (if (eieio-object-p c) (setq c (eieio-object-class c)))
+    (oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))
+
+  (static-method-class-method 'static-method-class-2 'class)
+  (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-class))
+  (static-method-class-method (static-method-class-2) 'object)
+  (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-object)))
+
+
+;;; Perform method testing
+;;
+
+;;; Multiple Inheritance, and method signal testing
+;;
+(defvar eitest-ab nil)
+(defvar eitest-a nil)
+(defvar eitest-b nil)
+(ert-deftest eieio-test-06-allocate-objects ()
+   ;; allocate an object to use
+   (should (setq eitest-ab (class-ab)))
+   (should (setq eitest-a (class-a)))
+   (should (setq eitest-b (class-b))))
+
+(ert-deftest eieio-test-07-make-instance ()
+  (should (make-instance 'class-ab))
+  (should (make-instance 'class-a :water 'cho))
+  (should (make-instance 'class-b)))
+
+(defmethod class-cn ((a class-a))
+  "Try calling `call-next-method' when there isn't one.
+Argument A is object of type symbol `class-a'."
+  (call-next-method))
+
+(defmethod no-next-method ((a class-a) &rest args)
+  "Override signal throwing for variable `class-a'.
+Argument A is the object of class variable `class-a'."
+  'moose)
+
+(ert-deftest eieio-test-08-call-next-method ()
+  ;; Play with call-next-method
+  (should (eq (class-cn eitest-ab) 'moose)))
+
+(defmethod no-applicable-method ((b class-b) method &rest args)
+  "No need.
+Argument B is for booger.
+METHOD is the method that was attempting to be called."
+  'moose)
+
+(ert-deftest eieio-test-09-no-applicable-method ()
+  ;; Non-existing methods.
+  (should (eq (class-cn eitest-b) 'moose)))
+
+(defmethod class-fun ((a class-a))
+  "Fun with class A."
+  'moose)
+
+(defmethod class-fun ((b class-b))
+  "Fun with class B."
+  (error "Class B fun should not be called")
+  )
+
+(defmethod class-fun-foo ((b class-b))
+  "Foo Fun with class B."
+  'moose)
+
+(defmethod class-fun2 ((a class-a))
+  "More fun with class A."
+  'moose)
+
+(defmethod class-fun2 ((b class-b))
+  "More fun with class B."
+  (error "Class B fun2 should not be called")
+  )
+
+(defmethod class-fun2 ((ab class-ab))
+  "More fun with class AB."
+  (call-next-method))
+
+;; How about if B is the only slot?
+(defmethod class-fun3 ((b class-b))
+  "Even More fun with class B."
+  'moose)
+
+(defmethod class-fun3 ((ab class-ab))
+  "Even More fun with class AB."
+  (call-next-method))
+
+(ert-deftest eieio-test-10-multiple-inheritance ()
+  ;; play with methods and mi
+  (should (eq (class-fun eitest-ab) 'moose))
+  (should (eq (class-fun-foo eitest-ab) 'moose))
+  ;; Play with next-method and mi
+  (should (eq (class-fun2 eitest-ab) 'moose))
+  (should (eq (class-fun3 eitest-ab) 'moose)))
+
+(ert-deftest eieio-test-11-self ()
+  ;; Try the self referencing test
+  (should (oset eitest-a self eitest-a))
+  (should (oset eitest-ab self eitest-ab)))
+
+
+(defvar class-fun-value-seq '())
+(defmethod class-fun-value :BEFORE ((a class-a))
+  "Return `before', and push `before' in `class-fun-value-seq'."
+  (push 'before class-fun-value-seq)
+  'before)
+
+(defmethod class-fun-value :PRIMARY ((a class-a))
+  "Return `primary', and push `primary' in `class-fun-value-seq'."
+  (push 'primary class-fun-value-seq)
+  'primary)
+
+(defmethod class-fun-value :AFTER ((a class-a))
+  "Return `after', and push `after' in `class-fun-value-seq'."
+  (push 'after class-fun-value-seq)
+  'after)
+
+(ert-deftest eieio-test-12-generic-function-call ()
+  ;; Test value of a generic function call
+  ;;
+  (let* ((class-fun-value-seq nil)
+	 (value (class-fun-value eitest-a)))
+    ;; Test if generic function call returns the primary method's value
+    (should (eq value 'primary))
+    ;; Make sure :before and :after methods were run
+    (should (equal class-fun-value-seq '(after primary before)))))
+
+;;; Test initialization methods
+;;
+
+(ert-deftest eieio-test-13-init-methods ()
+  (defmethod initialize-instance ((a class-a) &rest slots)
+    "Initialize the slots of class-a."
+    (call-next-method)
+    (if (/= (oref a test-tag) 1)
+	(error "shared-initialize test failed."))
+    (oset a test-tag 2))
+
+  (defmethod shared-initialize ((a class-a) &rest slots)
+    "Shared initialize method for class-a."
+    (call-next-method)
+    (oset a test-tag 1))
+
+  (let ((ca (class-a)))
+    (should-not (/=  (oref ca test-tag) 2))))
+
+
+;;; Perform slot testing
+;;
+(ert-deftest eieio-test-14-slots ()
+  ;; Check slot existence
+  (should (oref eitest-ab water))
+  (should (oref eitest-ab land))
+  (should (oref eitest-ab amphibian)))
+
+(ert-deftest eieio-test-15-slot-missing ()
+
+  (defmethod slot-missing ((ab class-ab) &rest foo)
+    "If a slot in AB is unbound, return something cool.  FOO."
+    'moose)
+
+  (should (eq (oref eitest-ab ooga-booga) 'moose))
+  (should-error (oref eitest-a ooga-booga) :type 'invalid-slot-name))
+
+(ert-deftest eieio-test-16-slot-makeunbound ()
+  (slot-makeunbound eitest-a 'water)
+  ;; Should now be unbound
+  (should-not (slot-boundp eitest-a 'water))
+  ;; But should still exist
+  (should (slot-exists-p eitest-a 'water))
+  (should-not (slot-exists-p eitest-a 'moose))
+  ;; oref of unbound slot must fail
+  (should-error (oref eitest-a water) :type 'unbound-slot))
+
+(defvar eitest-vsca nil)
+(defvar eitest-vscb nil)
+(defclass virtual-slot-class ()
+  ((base-value :initarg :base-value))
+  "Class has real slot :base-value and simulated slot :derived-value.")
+(defmethod slot-missing ((vsc virtual-slot-class)
+			 slot-name operation &optional new-value)
+  "Simulate virtual slot derived-value."
+  (cond
+   ((or (eq slot-name :derived-value)
+	(eq slot-name 'derived-value))
+    (with-slots (base-value) vsc
+      (if (eq operation 'oref)
+	  (+ base-value 1)
+	(setq base-value (- new-value 1)))))
+   (t (call-next-method))))
+
+(ert-deftest eieio-test-17-virtual-slot ()
+  (setq eitest-vsca (virtual-slot-class :base-value 1))
+  ;; Check slot values
+  (should (= (oref eitest-vsca base-value) 1))
+  (should (= (oref eitest-vsca :derived-value) 2))
+
+  (oset eitest-vsca derived-value 3)
+  (should (= (oref eitest-vsca base-value) 2))
+  (should (= (oref eitest-vsca :derived-value) 3))
+
+  (oset eitest-vsca base-value 3)
+  (should (= (oref eitest-vsca base-value) 3))
+  (should (= (oref eitest-vsca :derived-value) 4))
+
+  ;; should also be possible to initialize instance using virtual slot
+
+  (setq eitest-vscb (virtual-slot-class :derived-value 5))
+  (should (= (oref eitest-vscb base-value) 4))
+  (should (= (oref eitest-vscb :derived-value) 5)))
+
+(ert-deftest eieio-test-18-slot-unbound ()
+
+  (defmethod slot-unbound ((a class-a) &rest foo)
+    "If a slot in A is unbound, ignore FOO."
+    'moose)
+
+  (should (eq (oref eitest-a water) 'moose))
+
+  ;; Check if oset of unbound works
+  (oset eitest-a water 'moose)
+  (should (eq (oref eitest-a water) 'moose))
+
+  ;; oref/oref-default comparison
+  (should-not (eq (oref eitest-a water) (oref-default eitest-a water)))
+
+  ;; oset-default -> oref/oref-default comparison
+  (oset-default (eieio-object-class eitest-a) water 'moose)
+  (should (eq (oref eitest-a water) (oref-default eitest-a water)))
+
+  ;; After setting 'water to 'moose, make sure a new object has
+  ;; the right stuff.
+  (oset-default (eieio-object-class eitest-a) water 'penguin)
+  (should (eq (oref (class-a) water) 'penguin))
+
+  ;; Revert the above
+  (defmethod slot-unbound ((a class-a) &rest foo)
+    "If a slot in A is unbound, ignore FOO."
+    ;; Disable the old slot-unbound so we can run this test
+    ;; more than once
+    (call-next-method)))
+
+(ert-deftest eieio-test-19-slot-type-checking ()
+  ;; Slot type checking
+  ;; We should not be able to set a string here
+  (should-error (oset eitest-ab water "a string, not a symbol") :type 'invalid-slot-type)
+  (should-error (oset eitest-ab classslot "a string, not a symbol") :type 'invalid-slot-type)
+  (should-error (class-a :water "a string not a symbol") :type 'invalid-slot-type))
+
+(ert-deftest eieio-test-20-class-allocated-slots ()
+  ;; Test out class allocated slots
+  (defvar eitest-aa nil)
+  (setq eitest-aa (class-a))
+
+  ;; Make sure class slots do not track between objects
+  (let ((newval 'moose))
+    (oset eitest-aa classslot newval)
+    (should (eq (oref eitest-a classslot) newval))
+    (should (eq (oref eitest-aa classslot) newval)))
+
+  ;; Slot should be bound
+  (should (slot-boundp eitest-a 'classslot))
+  (should (slot-boundp 'class-a 'classslot))
+
+  (slot-makeunbound eitest-a 'classslot)
+
+  (should-not (slot-boundp eitest-a 'classslot))
+  (should-not (slot-boundp 'class-a 'classslot)))
+
+
+(defvar eieio-test-permuting-value nil)
+(defvar eitest-pvinit nil)
+(eval-and-compile
+  (setq eieio-test-permuting-value 1))
+
+(defclass inittest nil
+  ((staticval :initform 1)
+   (symval :initform eieio-test-permuting-value)
+   (evalval :initform (symbol-value 'eieio-test-permuting-value))
+   (evalnow :initform (symbol-value 'eieio-test-permuting-value)
+	    :allocation :class)
+   )
+  "Test initforms that eval.")
+
+(ert-deftest eieio-test-21-eval-at-construction-time ()
+  ;; initforms that need to be evalled at construction time.
+  (setq eieio-test-permuting-value 2)
+  (setq eitest-pvinit (inittest))
+
+  (should (eq (oref eitest-pvinit staticval) 1))
+  (should (eq (oref eitest-pvinit symval) 'eieio-test-permuting-value))
+  (should (eq (oref eitest-pvinit evalval) 2))
+  (should (eq (oref eitest-pvinit evalnow) 1)))
+
+(defvar eitest-tests nil)
+
+(ert-deftest eieio-test-22-init-forms-dont-match-runnable ()
+  ;; Init forms with types that don't match the runnable.
+  (defclass eitest-subordinate nil
+    ((text :initform "" :type string))
+    "Test class that will be a calculated value.")
+
+  (defclass eitest-superior nil
+    ((sub :initform (eitest-subordinate)
+	  :type eitest-subordinate))
+    "A class with an initform that creates a class.")
+
+  (should (setq eitest-tests (eitest-superior)))
+
+  (should-error
+   (eval
+    '(defclass broken-init nil
+       ((broken :initform 1
+		:type string))
+       "This class should break."))
+   :type 'invalid-slot-type))
+
+(ert-deftest eieio-test-23-inheritance-check ()
+  (should (child-of-class-p 'class-ab 'class-a))
+  (should (child-of-class-p 'class-ab 'class-b))
+  (should (object-of-class-p eitest-a 'class-a))
+  (should (object-of-class-p eitest-ab 'class-a))
+  (should (object-of-class-p eitest-ab 'class-b))
+  (should (object-of-class-p eitest-ab 'class-ab))
+  (should (eq (eieio-class-parents 'class-a) nil))
+  (should (equal (eieio-class-parents 'class-ab)
+                 (mapcar #'find-class '(class-a class-b))))
+  (should (same-class-p eitest-a 'class-a))
+  (should (class-a-p eitest-a))
+  (should (not (class-a-p eitest-ab)))
+  (should (cl-typep eitest-a 'class-a))
+  (should (cl-typep eitest-ab 'class-a))
+  (should (not (class-a-p "foo")))
+  (should (not (cl-typep "foo" 'class-a))))
+
+(ert-deftest eieio-test-24-object-predicates ()
+  (let ((listooa (list (class-ab) (class-a)))
+	(listoob (list (class-ab) (class-b))))
+    (should (cl-typep listooa '(list-of class-a)))
+    (should (cl-typep listoob '(list-of class-b)))
+    (should-not (cl-typep listooa '(list-of class-b)))
+    (should-not (cl-typep listoob '(list-of class-a)))))
+
+(defvar eitest-t1 nil)
+(ert-deftest eieio-test-25-slot-tests ()
+  (setq eitest-t1 (class-c))
+  ;; Slot initialization
+  (should (eq (oref eitest-t1 slot-1) 'moose))
+  ;; Accessing via the initarg name is deprecated!
+  ;; (should (eq (oref eitest-t1 :moose) 'moose))
+  ;; Don't pass reference of private slot
+  ;;PRIVATE (should-error (oref eitest-t1 slot-2) :type 'invalid-slot-name)
+  ;; Check private slot accessor
+  (should (string= (get-slot-2 eitest-t1) "penguin"))
+  ;; Pass string instead of symbol
+  (should-error (class-c :moose "not a symbol") :type 'invalid-slot-type)
+  (should (eq (get-slot-3 eitest-t1) 'emu))
+  (should (eq (get-slot-3 'class-c) 'emu))
+  ;; Check setf
+  (setf (get-slot-3 eitest-t1) 'setf-emu)
+  (should (eq (get-slot-3 eitest-t1) 'setf-emu))
+  ;; Roll back
+  (setf (get-slot-3 eitest-t1) 'emu))
+
+(defvar eitest-t2 nil)
+(ert-deftest eieio-test-26-default-inheritance ()
+  ;; See previous test, nor for subclass
+  (setq eitest-t2 (class-subc))
+  (should (eq (oref eitest-t2 slot-1) 'moose))
+  ;; Accessing via the initarg name is deprecated!
+  ;;(should (eq (oref eitest-t2 :moose) 'moose))
+  (should (string= (get-slot-2 eitest-t2) "linux"))
+  ;;PRIVATE (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
+  (should (string= (get-slot-2 eitest-t2) "linux"))
+  (should-error (class-subc :moose "not a symbol") :type 'invalid-slot-type))
+
+;;(ert-deftest eieio-test-27-inherited-new-value ()
+  ;;; HACK ALERT: The new value of a class slot is inherited by the
+  ;; subclass!  This is probably a bug.  We should either share the slot
+  ;; so sets on the baseclass change the subclass, or we should inherit
+  ;; the original value.
+;;  (should (eq (get-slot-3 eitest-t2) 'emu))
+;;  (should (eq (get-slot-3 class-subc) 'emu))
+;;  (setf (get-slot-3 eitest-t2) 'setf-emu)
+;;  (should (eq (get-slot-3 eitest-t2) 'setf-emu)))
+
+;; Slot protection
+(defclass prot-0 ()
+  ()
+  "Protection testing baseclass.")
+
+(defmethod prot0-slot-2 ((s2 prot-0))
+  "Try to access slot-2 from this class which doesn't have it.
+The object S2 passed in will be of class prot-1, which does have
+the slot.  This could be allowed, and currently is in EIEIO.
+Needed by the eieio persistent base class."
+  (oref s2 slot-2))
+
+(defclass prot-1 (prot-0)
+  ((slot-1 :initarg :slot-1
+	   :initform nil
+	   :protection :public)
+   (slot-2 :initarg :slot-2
+	   :initform nil
+	   :protection :protected)
+   (slot-3 :initarg :slot-3
+	   :initform nil
+	   :protection :private))
+  "A class for testing the :protection option.")
+
+(defclass prot-2 (prot-1)
+  nil
+  "A class for testing the :protection option.")
+
+(defmethod prot1-slot-2 ((s2 prot-1))
+  "Try to access slot-2 in S2."
+  (oref s2 slot-2))
+
+(defmethod prot1-slot-2 ((s2 prot-2))
+  "Try to access slot-2 in S2."
+  (oref s2 slot-2))
+
+(defmethod prot1-slot-3-only ((s2 prot-1))
+  "Try to access slot-3 in S2.
+Do not override for `prot-2'."
+  (oref s2 slot-3))
+
+(defmethod prot1-slot-3 ((s2 prot-1))
+  "Try to access slot-3 in S2."
+  (oref s2 slot-3))
+
+(defmethod prot1-slot-3 ((s2 prot-2))
+  "Try to access slot-3 in S2."
+  (oref s2 slot-3))
+
+(defvar eitest-p1 nil)
+(defvar eitest-p2 nil)
+(ert-deftest eieio-test-28-slot-protection ()
+  (setq eitest-p1 (prot-1))
+  (setq eitest-p2 (prot-2))
+  ;; Access public slots
+  (oref eitest-p1 slot-1)
+  (oref eitest-p2 slot-1)
+  ;; Accessing protected slot out of context used to fail, but we dropped this
+  ;; feature, since it was underused and no one noticed that the check was
+  ;; incorrect (much too loose).
+  ;;PROTECTED (should-error (oref eitest-p1 slot-2) :type 'invalid-slot-name)
+  ;; Access protected slot in method
+  (prot1-slot-2 eitest-p1)
+  ;; Protected slot in subclass method
+  (prot1-slot-2 eitest-p2)
+  ;; Protected slot from parent class method
+  (prot0-slot-2 eitest-p1)
+  ;; Accessing private slot out of context used to fail, but we dropped this
+  ;; feature, since it was not used.
+  ;;PRIVATE (should-error (oref eitest-p1 slot-3) :type 'invalid-slot-name)
+  ;; Access private slot in method
+  (prot1-slot-3 eitest-p1)
+  ;; Access private slot in subclass method must fail
+  ;;PRIVATE (should-error (prot1-slot-3 eitest-p2) :type 'invalid-slot-name)
+  ;; Access private slot by same class
+  (prot1-slot-3-only eitest-p1)
+  ;; Access private slot by subclass in sameclass method
+  (prot1-slot-3-only eitest-p2))
+
+;;; eieio-instance-inheritor
+;; Test to make sure this works.
+(defclass II (eieio-instance-inheritor)
+  ((slot1 :initform 1)
+   (slot2)
+   (slot3))
+  "Instance Inheritor test class.")
+
+(defvar eitest-II1 nil)
+(defvar eitest-II2 nil)
+(defvar eitest-II3 nil)
+(ert-deftest eieio-test-29-instance-inheritor ()
+  (setq eitest-II1 (II "II Test."))
+  (oset eitest-II1 slot2 'cat)
+  (setq eitest-II2 (clone eitest-II1 "eitest-II2 Test."))
+  (oset eitest-II2 slot1 'moose)
+  (setq eitest-II3 (clone eitest-II2 "eitest-II3 Test."))
+  (oset eitest-II3 slot3 'penguin)
+
+  ;; Test level 1 inheritance
+  (should (eq (oref eitest-II3 slot1) 'moose))
+  ;; Test level 2 inheritance
+  (should (eq (oref eitest-II3 slot2) 'cat))
+  ;; Test level 0 inheritance
+  (should (eq (oref eitest-II3 slot3) 'penguin)))
+
+(defclass slotattr-base ()
+  ((initform :initform init)
+   (type :type list)
+   (initarg :initarg :initarg)
+   (protection :protection :private)
+   (custom :custom (repeat string)
+	   :label "Custom Strings"
+	   :group moose)
+   (docstring :documentation
+	      "Replace the doc-string for this property.")
+   (printer :printer printer1)
+   )
+  "Baseclass we will attempt to subclass.
+Subclasses to override slot attributes.")
+
+(defclass slotattr-ok (slotattr-base)
+  ((initform :initform no-init)
+   (initarg :initarg :initblarg)
+   (custom :custom string
+	   :label "One String"
+	   :group cow)
+   (docstring :documentation
+	      "A better doc string for this class.")
+   (printer :printer printer2)
+   )
+  "This class should allow overriding of various slot attributes.")
+
+
+(ert-deftest eieio-test-30-slot-attribute-override ()
+  ;; Subclass should not override :protection slot attribute
+  ;;PROTECTION is gone.
+  ;;(should-error
+  ;;       (eval
+  ;;        '(defclass slotattr-fail (slotattr-base)
+  ;;           ((protection :protection :public)
+  ;;            )
+  ;;           "This class should throw an error.")))
+
+  ;; Subclass should not override :type slot attribute
+  (should-error
+	(eval
+	 '(defclass slotattr-fail (slotattr-base)
+	  ((type :type string)
+	   )
+	  "This class should throw an error.")))
+
+  ;; Initform should override instance allocation
+  (let ((obj (slotattr-ok)))
+    (should (eq (oref obj initform) 'no-init))))
+
+(defclass slotattr-class-base ()
+  ((initform :allocation :class
+	     :initform init)
+   (type :allocation :class
+	 :type list)
+   (initarg :allocation :class
+	    :initarg :initarg)
+   (protection :allocation :class
+	       :protection :private)
+   (custom :allocation :class
+	   :custom (repeat string)
+	   :label "Custom Strings"
+	   :group moose)
+   (docstring :allocation :class
+	      :documentation
+	      "Replace the doc-string for this property.")
+   )
+  "Baseclass we will attempt to subclass.
+Subclasses to override slot attributes.")
+
+(defclass slotattr-class-ok (slotattr-class-base)
+  ((initform :initform no-init)
+   (initarg :initarg :initblarg)
+   (custom :custom string
+	   :label "One String"
+	   :group cow)
+   (docstring :documentation
+	      "A better doc string for this class.")
+   )
+  "This class should allow overriding of various slot attributes.")
+
+
+(ert-deftest eieio-test-31-slot-attribute-override-class-allocation ()
+  ;; Same as test-30, but with class allocation
+  ;;PROTECTION is gone.
+  ;;(should-error
+  ;;     (eval
+  ;;      '(defclass slotattr-fail (slotattr-class-base)
+  ;;         ((protection :protection :public)
+  ;;          )
+  ;;         "This class should throw an error.")))
+  (should-error
+      (eval
+       '(defclass slotattr-fail (slotattr-class-base)
+	  ((type :type string)
+	   )
+	  "This class should throw an error.")))
+  (should (eq (oref-default 'slotattr-class-ok initform) 'no-init)))
+
+(ert-deftest eieio-test-32-slot-attribute-override-2 ()
+  (let* ((cv (cl--find-class 'slotattr-ok))
+         (slots  (eieio--class-slots cv))
+	 (args   (eieio--class-initarg-tuples cv)))
+    ;; :initarg should override for subclass
+    (should (assoc :initblarg args))
+
+    (dotimes (i (length slots))
+      (let* ((slot (aref slots i))
+             (props (cl--slot-descriptor-props slot)))
+        (cond
+         ((eq (cl--slot-descriptor-name slot) 'custom)
+          ;; Custom slot attributes must override
+          (should (eq (alist-get :custom props) 'string))
+          ;; Custom label slot attribute must override
+          (should (string= (alist-get :label props) "One String"))
+          (let ((grp (alist-get :group props)))
+            ;; Custom group slot attribute must combine
+            (should (and (memq 'moose grp) (memq 'cow grp)))))
+         (t nil))))))
+
+(defvar eitest-CLONETEST1 nil)
+(defvar eitest-CLONETEST2 nil)
+
+(ert-deftest eieio-test-32-test-clone-boring-objects ()
+  ;; A simple make instance with EIEIO extension
+  (should (setq eitest-CLONETEST1 (make-instance 'class-a)))
+  (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1)))
+
+  ;; CLOS form of make-instance
+  (should (setq eitest-CLONETEST1 (make-instance 'class-a)))
+  (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1))))
+
+(defclass IT (eieio-instance-tracker)
+  ((tracking-symbol :initform IT-list)
+   (slot1 :initform 'die))
+  "Instance Tracker test object.")
+
+(ert-deftest eieio-test-33-instance-tracker ()
+  (let (IT-list IT1)
+    (should (setq IT1 (IT)))
+    ;; The instance tracker must find this
+    (should (eieio-instance-tracker-find 'die 'slot1 'IT-list))
+    ;; Test deletion
+    (delete-instance IT1)
+    (should-not (eieio-instance-tracker-find 'die 'slot1 'IT-list))))
+
+(defclass SINGLE (eieio-singleton)
+  ((a-slot :initarg :a-slot :initform t))
+  "A Singleton test object.")
+
+(ert-deftest eieio-test-34-singletons ()
+  (let ((obj1 (SINGLE))
+	(obj2 (SINGLE)))
+    (should (eieio-object-p obj1))
+    (should (eieio-object-p obj2))
+    (should (eq obj1 obj2))
+    (should (oref obj1 a-slot))))
+
+(defclass NAMED (eieio-named)
+  ((some-slot :initform nil)
+   )
+  "A class inheriting from eieio-named.")
+
+(ert-deftest eieio-test-35-named-object ()
+  (let (N)
+    (should (setq N (NAMED :object-name "Foo")))
+    (should (string= "Foo" (oref N object-name)))
+    (should-error (oref N missing-slot) :type 'invalid-slot-name)
+    (oset N object-name "NewName")
+    (should (string= "NewName" (oref N object-name)))))
+
+(defclass opt-test1 ()
+  ()
+  "Abstract base class"
+  :abstract t)
+
+(defclass opt-test2 (opt-test1)
+  ()
+  "Instantiable child")
+
+(ert-deftest eieio-test-36-build-class-alist ()
+  (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2))
+  (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1)))
+
+(defclass eieio--testing () ())
+
+(defmethod constructor :static ((_x eieio--testing) newname &rest _args)
+  (list newname 2))
+
+(ert-deftest eieio-test-37-obsolete-name-in-constructor ()
+  (should (equal (eieio--testing "toto") '("toto" 2))))
+
+(provide 'eieio-tests)
+
+;;; eieio-tests.el ends here
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
new file mode 100644
index 00000000000..5382c400962
--- /dev/null
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -0,0 +1,843 @@
+;;; ert-tests.el --- ERT's self-tests  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2007-2008, 2010-2015 Free Software Foundation, Inc.
+
+;; Author: Christian Ohler <ohler@gnu.org>
+
+;; 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:
+
+;; This file is part of ERT, the Emacs Lisp Regression Testing tool.
+;; See ert.el or the texinfo manual for more details.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+
+;;; Self-test that doesn't rely on ERT, for bootstrapping.
+
+;; This is used to test that bodies actually run.
+(defvar ert--test-body-was-run)
+(ert-deftest ert-test-body-runs ()
+  (setq ert--test-body-was-run t))
+
+(defun ert-self-test ()
+  "Run ERT's self-tests and make sure they actually ran."
+  (let ((window-configuration (current-window-configuration)))
+    (let ((ert--test-body-was-run nil))
+      ;; 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*")))
+        (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)
+          (error "ERT self-test failed"))))))
+
+(defun ert-self-test-and-exit ()
+  "Run ERT's self-tests and exit Emacs.
+
+The exit code will be zero if the tests passed, nonzero if they
+failed or if there was a problem."
+  (unwind-protect
+      (progn
+        (ert-self-test)
+        (kill-emacs 0))
+    (unwind-protect
+        (progn
+          (message "Error running tests")
+          (backtrace))
+      (kill-emacs 1))))
+
+
+;;; Further tests are defined using ERT.
+
+(ert-deftest ert-test-nested-test-body-runs ()
+  "Test that nested test bodies run."
+  (let ((was-run nil))
+    (let ((test (make-ert-test :body (lambda ()
+                                       (setq was-run t)))))
+      (cl-assert (not was-run))
+      (ert-run-test test)
+      (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)))
+      (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))))
+      (cl-assert (ert-test-failed-p result) t)
+      (cl-assert (equal (ert-test-result-with-condition-condition result)
+                     '(ert-test-failed "failure message"))
+              t))))
+
+(ert-deftest ert-test-fail-debug-with-condition-case ()
+  (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
+    (condition-case condition
+        (progn
+          (let ((ert-debug-on-error t))
+            (ert-run-test test))
+          (cl-assert nil))
+      ((error)
+       (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 _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")))))
+    (cl-block nil
+      (let ((debugger (lambda (&rest _args)
+                        (cl-return-from nil nil))))
+        (let ((ert-debug-on-error t))
+          (ert-run-test test))
+        (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 _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"))))))
+    (cl-block nil
+      (let ((debugger (lambda (&rest _args)
+                        (cl-return-from nil nil))))
+        (let ((ert-debug-on-error t))
+          (ert-run-test test))
+        (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))))
+      (cl-assert (ert-test-failed-p result) t)
+      (cl-assert (equal (ert-test-result-with-condition-condition result)
+                     '(error "Error message"))
+              t))))
+
+(ert-deftest ert-test-error-debug ()
+  (let ((test (make-ert-test :body (lambda () (error "Error message")))))
+    (condition-case condition
+        (progn
+          (let ((ert-debug-on-error t))
+            (ert-run-test test))
+          (cl-assert nil))
+      ((error)
+       (cl-assert (equal condition '(error "Error message")) t)))))
+
+
+;;; Test that `should' works.
+(ert-deftest ert-test-should ()
+  (let ((test (make-ert-test :body (lambda () (should nil)))))
+    (let ((result (let ((ert-debug-on-error nil))
+                    (ert-run-test test))))
+      (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)))
+      (cl-assert (ert-test-passed-p result) t))))
+
+(ert-deftest ert-test-should-value ()
+  (should (eql (should 'foo) 'foo))
+  (should (eql (should 'bar) 'bar)))
+
+(ert-deftest ert-test-should-not ()
+  (let ((test (make-ert-test :body (lambda () (should-not t)))))
+    (let ((result (let ((ert-debug-on-error nil))
+                    (ert-run-test test))))
+      (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)))
+      (cl-assert (ert-test-passed-p result)))))
+
+
+(ert-deftest ert-test-should-with-macrolet ()
+  (let ((test (make-ert-test :body (lambda ()
+                                     (cl-macrolet ((foo () `(progn t nil)))
+                                       (should (foo)))))))
+    (let ((result (let ((ert-debug-on-error nil))
+                    (ert-run-test test))))
+      (should (ert-test-failed-p result))
+      (should (equal
+               (ert-test-result-with-condition-condition result)
+               '(ert-test-failed ((should (foo))
+                                  :form (progn t nil)
+                                  :value nil)))))))
+
+(ert-deftest ert-test-should-error ()
+  ;; No error.
+  (let ((test (make-ert-test :body (lambda () (should-error (progn))))))
+    (let ((result (let ((ert-debug-on-error nil))
+                    (ert-run-test test))))
+      (should (ert-test-failed-p result))
+      (should (equal (ert-test-result-with-condition-condition result)
+                     '(ert-test-failed
+                       ((should-error (progn))
+                        :form (progn)
+                        :value nil
+                        :fail-reason "did not signal an error"))))))
+  ;; A simple error.
+  (should (equal (should-error (error "Foo"))
+                 '(error "Foo")))
+  ;; Error of unexpected type.
+  (let ((test (make-ert-test :body (lambda ()
+                                     (should-error (error "Foo")
+                                                   :type 'singularity-error)))))
+    (let ((result (ert-run-test test)))
+      (should (ert-test-failed-p result))
+      (should (equal
+               (ert-test-result-with-condition-condition result)
+               '(ert-test-failed
+                 ((should-error (error "Foo") :type 'singularity-error)
+                  :form (error "Foo")
+                  :condition (error "Foo")
+                  :fail-reason
+                  "the error signaled did not have the expected type"))))))
+  ;; Error of the expected type.
+  (let* ((error nil)
+         (test (make-ert-test
+                :body (lambda ()
+                        (setq error
+                              (should-error (signal 'singularity-error nil)
+                                            :type 'singularity-error))))))
+    (let ((result (ert-run-test test)))
+      (should (ert-test-passed-p result))
+      (should (equal error '(singularity-error))))))
+
+(ert-deftest ert-test-should-error-subtypes ()
+  (should-error (signal 'singularity-error nil)
+                :type 'singularity-error
+                :exclude-subtypes t)
+  (let ((test (make-ert-test
+               :body (lambda ()
+                       (should-error (signal 'arith-error nil)
+                                     :type 'singularity-error)))))
+    (let ((result (ert-run-test test)))
+      (should (ert-test-failed-p result))
+      (should (equal
+               (ert-test-result-with-condition-condition result)
+               '(ert-test-failed
+                 ((should-error (signal 'arith-error nil)
+                                :type 'singularity-error)
+                  :form (signal arith-error nil)
+                  :condition (arith-error)
+                  :fail-reason
+                  "the error signaled did not have the expected type"))))))
+  (let ((test (make-ert-test
+               :body (lambda ()
+                       (should-error (signal 'arith-error nil)
+                                     :type 'singularity-error
+                                     :exclude-subtypes t)))))
+    (let ((result (ert-run-test test)))
+      (should (ert-test-failed-p result))
+      (should (equal
+               (ert-test-result-with-condition-condition result)
+               '(ert-test-failed
+                 ((should-error (signal 'arith-error nil)
+                                :type 'singularity-error
+                                :exclude-subtypes t)
+                  :form (signal arith-error nil)
+                  :condition (arith-error)
+                  :fail-reason
+                  "the error signaled did not have the expected type"))))))
+  (let ((test (make-ert-test
+               :body (lambda ()
+                       (should-error (signal 'singularity-error nil)
+                                     :type 'arith-error
+                                     :exclude-subtypes t)))))
+    (let ((result (ert-run-test test)))
+      (should (ert-test-failed-p result))
+      (should (equal
+               (ert-test-result-with-condition-condition result)
+               '(ert-test-failed
+                 ((should-error (signal 'singularity-error nil)
+                                :type 'arith-error
+                                :exclude-subtypes t)
+                  :form (signal singularity-error nil)
+                  :condition (singularity-error)
+                  :fail-reason
+                  "the error signaled was a subtype of the expected type")))))
+    ))
+
+(ert-deftest ert-test-skip-unless ()
+  ;; Don't skip.
+  (let ((test (make-ert-test :body (lambda () (skip-unless t)))))
+    (let ((result (ert-run-test test)))
+      (should (ert-test-passed-p result))))
+  ;; Skip.
+  (let ((test (make-ert-test :body (lambda () (skip-unless nil)))))
+    (let ((result (ert-run-test test)))
+      (should (ert-test-skipped-p result))))
+  ;; Skip in case of error.
+  (let ((test (make-ert-test :body (lambda () (skip-unless (error "Foo"))))))
+    (let ((result (ert-run-test test)))
+      (should (ert-test-skipped-p result)))))
+
+(defmacro ert--test-my-list (&rest args)
+  "Don't use this.  Instead, call `list' with ARGS, it does the same thing.
+
+This macro is used to test if macroexpansion in `should' works."
+  `(list ,@args))
+
+(ert-deftest ert-test-should-failure-debugging ()
+  "Test that `should' errors contain the information we expect them to."
+  (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 ()
+  ;; FIXME: These tests don't look very good.  What is their intent, i.e. what
+  ;; are they really testing?  The precise generated code shouldn't matter, so
+  ;; we should either test the behavior of the code, or else try to express the
+  ;; kind of efficiency guarantees we're looking for.
+  (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar)))
+		 '(progn
+		    (ert-set-test 'abc
+				  (progn
+				    "Constructor for objects of type `ert-test'."
+				    (vector 'cl-struct-ert-test 'abc "foo"
+					    #'(lambda nil)
+					    nil ':passed
+					    '(bar))))
+		    (setq current-load-list
+			  (cons
+			   '(ert-deftest . abc)
+			   current-load-list))
+		    'abc)))
+  (should (equal (macroexpand '(ert-deftest def ()
+                                 :expected-result ':passed))
+		 '(progn
+		    (ert-set-test 'def
+				  (progn
+				    "Constructor for objects of type `ert-test'."
+				    (vector 'cl-struct-ert-test 'def nil
+					    #'(lambda nil)
+					    nil ':passed 'nil)))
+		    (setq current-load-list
+			  (cons
+			   '(ert-deftest . def)
+			   current-load-list))
+		    'def)))
+  ;; :documentation keyword is forbidden
+  (should-error (macroexpand '(ert-deftest ghi ()
+                                :documentation "foo"))))
+
+(ert-deftest ert-test-record-backtrace ()
+  (let ((test (make-ert-test :body (lambda () (ert-fail "foo")))))
+    (let ((result (ert-run-test test)))
+      (should (ert-test-failed-p result))
+      (with-temp-buffer
+        (ert--print-backtrace (ert-test-failed-backtrace result))
+        (goto-char (point-min))
+	(end-of-line)
+	(let ((first-line (buffer-substring-no-properties (point-min) (point))))
+	  (should (equal first-line "  (closure (ert--test-body-was-run t) nil (ert-fail \"foo\"))()")))))))
+
+(ert-deftest ert-test-messages ()
+  :tags '(:causes-redisplay)
+  (let* ((message-string "Test message")
+         (messages-buffer (get-buffer-create "*Messages*"))
+         (test (make-ert-test :body (lambda () (message "%s" message-string)))))
+    (with-current-buffer messages-buffer
+      (let ((result (ert-run-test test)))
+        (should (equal (concat message-string "\n")
+                       (ert-test-result-messages result)))))))
+
+(ert-deftest ert-test-running-tests ()
+  (let ((outer-test (ert-get-test 'ert-test-running-tests)))
+    (should (equal (ert-running-test) outer-test))
+    (let (test1 test2 test3)
+      (setq test1 (make-ert-test
+                   :name "1"
+                   :body (lambda ()
+                           (should (equal (ert-running-test) outer-test))
+                           (should (equal ert--running-tests
+                                          (list test1 test2 test3
+                                                outer-test)))))
+            test2 (make-ert-test
+                   :name "2"
+                   :body (lambda ()
+                           (should (equal (ert-running-test) outer-test))
+                           (should (equal ert--running-tests
+                                          (list test3 test2 outer-test)))
+                           (ert-run-test test1)))
+            test3 (make-ert-test
+                   :name "3"
+                   :body (lambda ()
+                           (should (equal (ert-running-test) outer-test))
+                           (should (equal ert--running-tests
+                                          (list test3 outer-test)))
+                           (ert-run-test test2))))
+      (should (ert-test-passed-p (ert-run-test test3))))))
+
+(ert-deftest ert-test-test-result-expected-p ()
+  "Test `ert-test-result-expected-p' and (implicitly) `ert-test-result-type-p'."
+  ;; passing test
+  (let ((test (make-ert-test :body (lambda ()))))
+    (should (ert-test-result-expected-p test (ert-run-test test))))
+  ;; unexpected failure
+  (let ((test (make-ert-test :body (lambda () (ert-fail "failed")))))
+    (should-not (ert-test-result-expected-p test (ert-run-test test))))
+  ;; expected failure
+  (let ((test (make-ert-test :body (lambda () (ert-fail "failed"))
+                             :expected-result-type ':failed)))
+    (should (ert-test-result-expected-p test (ert-run-test test))))
+  ;; `not' expected type
+  (let ((test (make-ert-test :body (lambda ())
+                             :expected-result-type '(not :failed))))
+    (should (ert-test-result-expected-p test (ert-run-test test))))
+  (let ((test (make-ert-test :body (lambda ())
+                             :expected-result-type '(not :passed))))
+    (should-not (ert-test-result-expected-p test (ert-run-test test))))
+  ;; `and' expected type
+  (let ((test (make-ert-test :body (lambda ())
+                             :expected-result-type '(and :passed :failed))))
+    (should-not (ert-test-result-expected-p test (ert-run-test test))))
+  (let ((test (make-ert-test :body (lambda ())
+                             :expected-result-type '(and :passed
+                                                         (not :failed)))))
+    (should (ert-test-result-expected-p test (ert-run-test test))))
+  ;; `or' expected type
+  (let ((test (make-ert-test :body (lambda ())
+                             :expected-result-type '(or (and :passed :failed)
+                                                        :passed))))
+    (should (ert-test-result-expected-p test (ert-run-test test))))
+  (let ((test (make-ert-test :body (lambda ())
+                             :expected-result-type '(or (and :passed :failed)
+                                                        nil (not t)))))
+    (should-not (ert-test-result-expected-p test (ert-run-test test)))))
+
+;;; Test `ert-select-tests'.
+(ert-deftest ert-test-select-regexp ()
+  (should (equal (ert-select-tests "^ert-test-select-regexp$" t)
+                 (list (ert-get-test 'ert-test-select-regexp)))))
+
+(ert-deftest ert-test-test-boundp ()
+  (should (ert-test-boundp 'ert-test-test-boundp))
+  (should-not (ert-test-boundp (make-symbol "ert-not-a-test"))))
+
+(ert-deftest ert-test-select-member ()
+  (should (equal (ert-select-tests '(member ert-test-select-member) t)
+                 (list (ert-get-test 'ert-test-select-member)))))
+
+(ert-deftest ert-test-select-test ()
+  (should (equal (ert-select-tests (ert-get-test 'ert-test-select-test) t)
+                 (list (ert-get-test 'ert-test-select-test)))))
+
+(ert-deftest ert-test-select-symbol ()
+  (should (equal (ert-select-tests 'ert-test-select-symbol t)
+                 (list (ert-get-test 'ert-test-select-symbol)))))
+
+(ert-deftest ert-test-select-and ()
+  (let ((test (make-ert-test
+               :name nil
+               :body nil
+               :most-recent-result (make-ert-test-failed
+                                    :condition nil
+                                    :backtrace nil
+                                    :infos nil))))
+    (should (equal (ert-select-tests `(and (member ,test) :failed) t)
+                   (list test)))))
+
+(ert-deftest ert-test-select-tag ()
+  (let ((test (make-ert-test
+               :name nil
+               :body nil
+               :tags '(a b))))
+    (should (equal (ert-select-tests `(tag a) (list test)) (list test)))
+    (should (equal (ert-select-tests `(tag b) (list test)) (list test)))
+    (should (equal (ert-select-tests `(tag c) (list test)) '()))))
+
+
+;;; Tests for utility functions.
+(ert-deftest ert-test-proper-list-p ()
+  (should (ert--proper-list-p '()))
+  (should (ert--proper-list-p '(1)))
+  (should (ert--proper-list-p '(1 2)))
+  (should (ert--proper-list-p '(1 2 3)))
+  (should (ert--proper-list-p '(1 2 3 4)))
+  (should (not (ert--proper-list-p 'a)))
+  (should (not (ert--proper-list-p '(1 . a))))
+  (should (not (ert--proper-list-p '(1 2 . a))))
+  (should (not (ert--proper-list-p '(1 2 3 . a))))
+  (should (not (ert--proper-list-p '(1 2 3 4 . a))))
+  (let ((a (list 1)))
+    (setf (cdr (last a)) a)
+    (should (not (ert--proper-list-p a))))
+  (let ((a (list 1 2)))
+    (setf (cdr (last a)) a)
+    (should (not (ert--proper-list-p a))))
+  (let ((a (list 1 2 3)))
+    (setf (cdr (last a)) a)
+    (should (not (ert--proper-list-p a))))
+  (let ((a (list 1 2 3 4)))
+    (setf (cdr (last a)) a)
+    (should (not (ert--proper-list-p a))))
+  (let ((a (list 1 2)))
+    (setf (cdr (last a)) (cdr a))
+    (should (not (ert--proper-list-p a))))
+  (let ((a (list 1 2 3)))
+    (setf (cdr (last a)) (cdr a))
+    (should (not (ert--proper-list-p a))))
+  (let ((a (list 1 2 3 4)))
+    (setf (cdr (last a)) (cdr a))
+    (should (not (ert--proper-list-p a))))
+  (let ((a (list 1 2 3)))
+    (setf (cdr (last a)) (cddr a))
+    (should (not (ert--proper-list-p a))))
+  (let ((a (list 1 2 3 4)))
+    (setf (cdr (last a)) (cddr a))
+    (should (not (ert--proper-list-p a))))
+  (let ((a (list 1 2 3 4)))
+    (setf (cdr (last a)) (cl-cdddr a))
+    (should (not (ert--proper-list-p a)))))
+
+(ert-deftest ert-test-parse-keys-and-body ()
+  (should (equal (ert--parse-keys-and-body '(foo)) '(nil (foo))))
+  (should (equal (ert--parse-keys-and-body '(:bar foo)) '((:bar foo) nil)))
+  (should (equal (ert--parse-keys-and-body '(:bar foo a (b)))
+                 '((:bar foo) (a (b)))))
+  (should (equal (ert--parse-keys-and-body '(:bar foo :a (b)))
+                 '((:bar foo :a (b)) nil)))
+  (should (equal (ert--parse-keys-and-body '(bar foo :a (b)))
+                 '(nil (bar foo :a (b)))))
+  (should-error (ert--parse-keys-and-body '(:bar foo :a))))
+
+
+(ert-deftest ert-test-run-tests-interactively ()
+  :tags '(:causes-redisplay)
+  (let ((passing-test (make-ert-test :name 'passing-test
+                                     :body (lambda () (ert-pass))))
+        (failing-test (make-ert-test :name 'failing-test
+                                     :body (lambda () (ert-fail
+                                                       "failure message"))))
+        (skipped-test (make-ert-test :name 'skipped-test
+                                     :body (lambda () (ert-skip
+                                                       "skip message")))))
+    (let ((ert-debug-on-error nil))
+      (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*"))
+             (messages nil)
+             (mock-message-fn
+              (lambda (format-string &rest args)
+                (push (apply #'format format-string args) messages))))
+        (save-window-excursion
+          (unwind-protect
+              (let ((case-fold-search nil))
+                (ert-run-tests-interactively
+                 `(member ,passing-test ,failing-test, skipped-test) buffer-name
+                 mock-message-fn)
+                (should (equal messages `(,(concat
+                                            "Ran 3 tests, 1 results were "
+                                            "as expected, 1 unexpected, "
+					    "1 skipped"))))
+                (with-current-buffer buffer-name
+                  (goto-char (point-min))
+                  (should (equal
+                           (buffer-substring (point-min)
+                                             (save-excursion
+                                               (forward-line 5)
+                                               (point)))
+                           (concat
+                            "Selector: (member <passing-test> <failing-test> "
+			    "<skipped-test>)\n"
+                            "Passed:  1\n"
+                            "Failed:  1 (1 unexpected)\n"
+			    "Skipped: 1\n"
+                            "Total:   3/3\n")))))
+            (when (get-buffer buffer-name)
+              (kill-buffer buffer-name))))))))
+
+(ert-deftest ert-test-special-operator-p ()
+  (should (ert--special-operator-p 'if))
+  (should-not (ert--special-operator-p 'car))
+  (should-not (ert--special-operator-p 'ert--special-operator-p))
+  (let ((b (cl-gensym)))
+    (should-not (ert--special-operator-p b))
+    (fset b 'if)
+    (should (ert--special-operator-p b))))
+
+(ert-deftest ert-test-list-of-should-forms ()
+  (let ((test (make-ert-test :body (lambda ()
+                                     (should t)
+                                     (should (null '()))
+                                     (should nil)
+                                     (should t)))))
+    (let ((result (let ((ert-debug-on-error nil))
+                    (ert-run-test test))))
+      (should (equal (ert-test-result-should-forms result)
+                     '(((should t) :form t :value t)
+                       ((should (null '())) :form (null nil) :value t)
+                       ((should nil) :form nil :value nil)))))))
+
+(ert-deftest ert-test-list-of-should-forms-observers-should-not-stack ()
+  (let ((test (make-ert-test
+               :body (lambda ()
+                       (let ((test2 (make-ert-test
+                                     :body (lambda ()
+                                             (should t)))))
+                         (let ((result (ert-run-test test2)))
+                           (should (ert-test-passed-p result))))))))
+    (let ((result (let ((ert-debug-on-error nil))
+                    (ert-run-test test))))
+      (should (ert-test-passed-p result))
+      (should (eql (length (ert-test-result-should-forms result))
+                   1)))))
+
+(ert-deftest ert-test-list-of-should-forms-no-deep-copy ()
+  (let ((test (make-ert-test :body (lambda ()
+                                     (let ((obj (list 'a)))
+                                       (should (equal obj '(a)))
+                                       (setf (car obj) 'b)
+                                       (should (equal obj '(b))))))))
+    (let ((result (let ((ert-debug-on-error nil))
+                    (ert-run-test test))))
+      (should (ert-test-passed-p result))
+      (should (equal (ert-test-result-should-forms result)
+                     '(((should (equal obj '(a))) :form (equal (b) (a)) :value t
+                        :explanation nil)
+                       ((should (equal obj '(b))) :form (equal (b) (b)) :value t
+                        :explanation nil)
+                       ))))))
+
+(ert-deftest ert-test-string-first-line ()
+  (should (equal (ert--string-first-line "") ""))
+  (should (equal (ert--string-first-line "abc") "abc"))
+  (should (equal (ert--string-first-line "abc\n") "abc"))
+  (should (equal (ert--string-first-line "foo\nbar") "foo"))
+  (should (equal (ert--string-first-line " foo\nbar\nbaz\n") " foo")))
+
+(ert-deftest ert-test-explain-equal ()
+  (should (equal (ert--explain-equal nil 'foo)
+                 '(different-atoms nil foo)))
+  (should (equal (ert--explain-equal '(a a) '(a b))
+                 '(list-elt 1 (different-atoms a b))))
+  (should (equal (ert--explain-equal '(1 48) '(1 49))
+                 '(list-elt 1 (different-atoms (48 "#x30" "?0")
+                                               (49 "#x31" "?1")))))
+  (should (equal (ert--explain-equal 'nil '(a))
+                 '(different-types nil (a))))
+  (should (equal (ert--explain-equal '(a b c) '(a b c d))
+                 '(proper-lists-of-different-length 3 4 (a b c) (a b c d)
+                                                    first-mismatch-at 3)))
+  (let ((sym (make-symbol "a")))
+    (should (equal (ert--explain-equal 'a sym)
+                   `(different-symbols-with-the-same-name a ,sym)))))
+
+(ert-deftest ert-test-explain-equal-improper-list ()
+  (should (equal (ert--explain-equal '(a . b) '(a . c))
+                 '(cdr (different-atoms b c)))))
+
+(ert-deftest ert-test-explain-equal-keymaps ()
+  ;; This used to be very slow.
+  (should (equal (make-keymap) (make-keymap)))
+  (should (equal (make-sparse-keymap) (make-sparse-keymap))))
+
+(ert-deftest ert-test-significant-plist-keys ()
+  (should (equal (ert--significant-plist-keys '()) '()))
+  (should (equal (ert--significant-plist-keys '(a b c d e f c g p q r nil s t))
+                 '(a c e p s))))
+
+(ert-deftest ert-test-plist-difference-explanation ()
+  (should (equal (ert--plist-difference-explanation
+                  '(a b c nil) '(a b))
+                 nil))
+  (should (equal (ert--plist-difference-explanation
+                  '(a b c t) '(a b))
+                 '(different-properties-for-key c (different-atoms t nil))))
+  (should (equal (ert--plist-difference-explanation
+                  '(a b c t) '(c nil a b))
+                 '(different-properties-for-key c (different-atoms t nil))))
+  (should (equal (ert--plist-difference-explanation
+                  '(a b c (foo . bar)) '(c (foo . baz) a b))
+                 '(different-properties-for-key c
+                                                (cdr
+                                                 (different-atoms bar baz))))))
+
+(ert-deftest ert-test-abbreviate-string ()
+  (should (equal (ert--abbreviate-string "foo" 4 nil) "foo"))
+  (should (equal (ert--abbreviate-string "foo" 3 nil) "foo"))
+  (should (equal (ert--abbreviate-string "foo" 3 nil) "foo"))
+  (should (equal (ert--abbreviate-string "foo" 2 nil) "fo"))
+  (should (equal (ert--abbreviate-string "foo" 1 nil) "f"))
+  (should (equal (ert--abbreviate-string "foo" 0 nil) ""))
+  (should (equal (ert--abbreviate-string "bar" 4 t) "bar"))
+  (should (equal (ert--abbreviate-string "bar" 3 t) "bar"))
+  (should (equal (ert--abbreviate-string "bar" 3 t) "bar"))
+  (should (equal (ert--abbreviate-string "bar" 2 t) "ar"))
+  (should (equal (ert--abbreviate-string "bar" 1 t) "r"))
+  (should (equal (ert--abbreviate-string "bar" 0 t) "")))
+
+(ert-deftest ert-test-explain-equal-string-properties ()
+  (should
+   (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b))
+                                                   "foo")
+          '(char 0 "f"
+                 (different-properties-for-key a (different-atoms b nil))
+                 context-before ""
+                 context-after "oo")))
+  (should (equal (ert--explain-equal-including-properties
+                  #("foo" 1 3 (a b))
+                  #("goo" 0 1 (c d)))
+                 '(array-elt 0 (different-atoms (?f "#x66" "?f")
+                                                (?g "#x67" "?g")))))
+  (should
+   (equal (ert--explain-equal-including-properties
+           #("foo" 0 1 (a b c d) 1 3 (a b))
+           #("foo" 0 1 (c d a b) 1 2 (a foo)))
+          '(char 1 "o" (different-properties-for-key a (different-atoms b foo))
+                 context-before "f" context-after "o"))))
+
+(ert-deftest ert-test-equal-including-properties ()
+  (should (equal-including-properties "foo" "foo"))
+  (should (ert-equal-including-properties "foo" "foo"))
+
+  (should (equal-including-properties #("foo" 0 3 (a b))
+                                      (propertize "foo" 'a 'b)))
+  (should (ert-equal-including-properties #("foo" 0 3 (a b))
+                                          (propertize "foo" 'a 'b)))
+
+  (should (equal-including-properties #("foo" 0 3 (a b c d))
+                                      (propertize "foo" 'a 'b 'c 'd)))
+  (should (ert-equal-including-properties #("foo" 0 3 (a b c d))
+                                          (propertize "foo" 'a 'b 'c 'd)))
+
+  (should-not (equal-including-properties #("foo" 0 3 (a b c e))
+                                          (propertize "foo" 'a 'b 'c 'd)))
+  (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e))
+                                              (propertize "foo" 'a 'b 'c 'd)))
+
+  ;; This is bug 6581.
+  (should-not (equal-including-properties #("foo" 0 3 (a (t)))
+                                          (propertize "foo" 'a (list t))))
+  (should (ert-equal-including-properties #("foo" 0 3 (a (t)))
+                                          (propertize "foo" 'a (list t)))))
+
+(ert-deftest ert-test-stats-set-test-and-result ()
+  (let* ((test-1 (make-ert-test :name 'test-1
+                                :body (lambda () nil)))
+         (test-2 (make-ert-test :name 'test-2
+                                :body (lambda () nil)))
+         (test-3 (make-ert-test :name 'test-2
+                                :body (lambda () nil)))
+         (stats (ert--make-stats (list test-1 test-2) 't))
+         (failed (make-ert-test-failed :condition nil
+                                       :backtrace nil
+                                       :infos nil))
+         (skipped (make-ert-test-skipped :condition nil
+					 :backtrace nil
+					 :infos nil)))
+    (should (eql 2 (ert-stats-total stats)))
+    (should (eql 0 (ert-stats-completed stats)))
+    (should (eql 0 (ert-stats-completed-expected stats)))
+    (should (eql 0 (ert-stats-completed-unexpected stats)))
+    (should (eql 0 (ert-stats-skipped stats)))
+    (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed))
+    (should (eql 2 (ert-stats-total stats)))
+    (should (eql 1 (ert-stats-completed stats)))
+    (should (eql 1 (ert-stats-completed-expected stats)))
+    (should (eql 0 (ert-stats-completed-unexpected stats)))
+    (should (eql 0 (ert-stats-skipped stats)))
+    (ert--stats-set-test-and-result stats 0 test-1 failed)
+    (should (eql 2 (ert-stats-total stats)))
+    (should (eql 1 (ert-stats-completed stats)))
+    (should (eql 0 (ert-stats-completed-expected stats)))
+    (should (eql 1 (ert-stats-completed-unexpected stats)))
+    (should (eql 0 (ert-stats-skipped stats)))
+    (ert--stats-set-test-and-result stats 0 test-1 nil)
+    (should (eql 2 (ert-stats-total stats)))
+    (should (eql 0 (ert-stats-completed stats)))
+    (should (eql 0 (ert-stats-completed-expected stats)))
+    (should (eql 0 (ert-stats-completed-unexpected stats)))
+    (should (eql 0 (ert-stats-skipped stats)))
+    (ert--stats-set-test-and-result stats 0 test-3 failed)
+    (should (eql 2 (ert-stats-total stats)))
+    (should (eql 1 (ert-stats-completed stats)))
+    (should (eql 0 (ert-stats-completed-expected stats)))
+    (should (eql 1 (ert-stats-completed-unexpected stats)))
+    (should (eql 0 (ert-stats-skipped stats)))
+    (ert--stats-set-test-and-result stats 1 test-2 (make-ert-test-passed))
+    (should (eql 2 (ert-stats-total stats)))
+    (should (eql 2 (ert-stats-completed stats)))
+    (should (eql 1 (ert-stats-completed-expected stats)))
+    (should (eql 1 (ert-stats-completed-unexpected stats)))
+    (should (eql 0 (ert-stats-skipped stats)))
+    (ert--stats-set-test-and-result stats 0 test-1 (make-ert-test-passed))
+    (should (eql 2 (ert-stats-total stats)))
+    (should (eql 2 (ert-stats-completed stats)))
+    (should (eql 2 (ert-stats-completed-expected stats)))
+    (should (eql 0 (ert-stats-completed-unexpected stats)))
+    (should (eql 0 (ert-stats-skipped stats)))
+    (ert--stats-set-test-and-result stats 0 test-1 skipped)
+    (should (eql 2 (ert-stats-total stats)))
+    (should (eql 2 (ert-stats-completed stats)))
+    (should (eql 1 (ert-stats-completed-expected stats)))
+    (should (eql 0 (ert-stats-completed-unexpected stats)))
+    (should (eql 1 (ert-stats-skipped stats)))))
+
+
+(provide 'ert-tests)
+
+;;; ert-tests.el ends here
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el
new file mode 100644
index 00000000000..660a1cb218e
--- /dev/null
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -0,0 +1,280 @@
+;;; ert-x-tests.el --- Tests for ert-x.el
+
+;; Copyright (C) 2008, 2010-2015 Free Software Foundation, Inc.
+
+;; Author: Phil Hagelberg
+;; 	   Christian Ohler <ohler@gnu.org>
+
+;; 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:
+
+;; This file is part of ERT, the Emacs Lisp Regression Testing tool.
+;; See ert.el or the texinfo manual for more details.
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl-lib))
+(require 'ert)
+(require 'ert-x)
+
+;;; Utilities
+
+(ert-deftest ert-test-buffer-string-reindented ()
+  (ert-with-test-buffer (:name "well-indented")
+    (insert (concat "(hello (world\n"
+                    "        'elisp)\n"))
+    (emacs-lisp-mode)
+    (should (equal (ert-buffer-string-reindented) (buffer-string))))
+  (ert-with-test-buffer (:name "badly-indented")
+    (insert (concat "(hello\n"
+                    "       world)"))
+    (emacs-lisp-mode)
+    (should-not (equal (ert-buffer-string-reindented) (buffer-string)))))
+
+(defun ert--hash-table-to-alist (table)
+  (let ((accu nil))
+    (maphash (lambda (key value)
+	       (push (cons key value) accu))
+	     table)
+    (nreverse accu)))
+
+(ert-deftest ert-test-test-buffers ()
+  (let (buffer-1
+        buffer-2)
+    (let ((test-1
+           (make-ert-test
+            :name 'test-1
+            :body (lambda ()
+                    (ert-with-test-buffer (:name "foo")
+                      (should (string-match
+                               "[*]Test buffer (ert-test-test-buffers): foo[*]"
+                               (buffer-name)))
+                      (setq buffer-1 (current-buffer))))))
+          (test-2
+           (make-ert-test
+            :name 'test-2
+            :body (lambda ()
+                    (ert-with-test-buffer (:name "bar")
+                      (should (string-match
+                               "[*]Test buffer (ert-test-test-buffers): bar[*]"
+                               (buffer-name)))
+                      (setq buffer-2 (current-buffer))
+                      (ert-fail "fail for test"))))))
+      (let ((ert--test-buffers (make-hash-table :weakness t)))
+        (ert-run-tests `(member ,test-1 ,test-2) #'ignore)
+        (should (equal (ert--hash-table-to-alist ert--test-buffers)
+                       `((,buffer-2 . t))))
+        (should-not (buffer-live-p buffer-1))
+        (should (buffer-live-p buffer-2))))))
+
+
+(ert-deftest ert-filter-string ()
+  (should (equal (ert-filter-string "foo bar baz" "quux")
+                 "foo bar baz"))
+  (should (equal (ert-filter-string "foo bar baz" "bar")
+                 "foo  baz")))
+
+(ert-deftest ert-propertized-string ()
+  (should (ert-equal-including-properties
+           (ert-propertized-string "a" '(a b) "b" '(c t) "cd")
+           #("abcd" 1 2 (a b) 2 4 (c t))))
+  (should (ert-equal-including-properties
+           (ert-propertized-string "foo " '(face italic) "bar" " baz" nil
+                                   " quux")
+           #("foo bar baz quux" 4 11 (face italic)))))
+
+
+;;; Tests for ERT itself that require test features from ert-x.el.
+
+(ert-deftest ert-test-run-tests-interactively-2 ()
+  :tags '(:causes-redisplay)
+  (let* ((passing-test (make-ert-test :name 'passing-test
+                                      :body (lambda () (ert-pass))))
+         (failing-test (make-ert-test :name 'failing-test
+                                      :body (lambda ()
+                                              (ert-info ((propertize "foo\nbar"
+                                                                     'a 'b))
+                                                (ert-fail
+                                                 "failure message")))))
+         (skipped-test (make-ert-test :name 'skipped-test
+                                      :body (lambda () (ert-skip
+							"skip message"))))
+         (ert-debug-on-error nil)
+         (buffer-name (generate-new-buffer-name "*ert-test-run-tests*"))
+         (messages nil)
+         (mock-message-fn
+          (lambda (format-string &rest args)
+            (push (apply #'format format-string args) messages))))
+    (cl-flet ((expected-string (with-font-lock-p)
+                (ert-propertized-string
+                 "Selector: (member <passing-test> <failing-test> "
+		 "<skipped-test>)\n"
+                 "Passed:  1\n"
+                 "Failed:  1 (1 unexpected)\n"
+                 "Skipped: 1\n"
+                 "Total:   3/3\n\n"
+                 "Started at:\n"
+                 "Finished.\n"
+                 "Finished at:\n\n"
+                 `(category ,(button-category-symbol
+                              'ert--results-progress-bar-button)
+                            button (t)
+                            face ,(if with-font-lock-p
+                                      'ert-test-result-unexpected
+                                    'button))
+                 ".Fs" nil "\n\n"
+                 `(category ,(button-category-symbol
+                              'ert--results-expand-collapse-button)
+                            button (t)
+                            face ,(if with-font-lock-p
+                                      'ert-test-result-unexpected
+                                    'button))
+                 "F" nil " "
+                 `(category ,(button-category-symbol
+                              'ert--test-name-button)
+                            button (t)
+                            ert-test-name failing-test)
+                 "failing-test"
+                 nil "\n    Info: " '(a b) "foo\n"
+                 nil "          " '(a b) "bar"
+                 nil "\n    (ert-test-failed \"failure message\")\n\n\n"
+                 )))
+      (save-window-excursion
+        (unwind-protect
+            (let ((case-fold-search nil))
+              (ert-run-tests-interactively
+               `(member ,passing-test ,failing-test ,skipped-test) buffer-name
+               mock-message-fn)
+              (should (equal messages `(,(concat
+                                          "Ran 3 tests, 1 results were "
+                                          "as expected, 1 unexpected, "
+					  "1 skipped"))))
+              (with-current-buffer buffer-name
+                (font-lock-mode 0)
+                (should (ert-equal-including-properties
+                         (ert-filter-string (buffer-string)
+                                            '("Started at:\\(.*\\)$" 1)
+                                            '("Finished at:\\(.*\\)$" 1))
+                         (expected-string nil)))
+                ;; `font-lock-mode' only works if interactive, so
+                ;; pretend we are.
+                (let ((noninteractive nil))
+                  (font-lock-mode 1))
+                (should (ert-equal-including-properties
+                         (ert-filter-string (buffer-string)
+                                            '("Started at:\\(.*\\)$" 1)
+                                            '("Finished at:\\(.*\\)$" 1))
+                         (expected-string t)))))
+          (when (get-buffer buffer-name)
+            (kill-buffer buffer-name)))))))
+
+(ert-deftest ert-test-describe-test ()
+  "Tests `ert-describe-test'."
+  (save-window-excursion
+    (ert-with-buffer-renamed ("*Help*")
+      (if (< emacs-major-version 24)
+          (should (equal (should-error (ert-describe-test 'ert-describe-test))
+                         '(error "Requires Emacs 24")))
+        (ert-describe-test 'ert-test-describe-test)
+        (with-current-buffer "*Help*"
+          (let ((case-fold-search nil))
+            (should (string-match (concat
+                                   "\\`ert-test-describe-test is a test"
+                                   " defined in"
+                                   " ['`‘]ert-x-tests.elc?['’]\\.\n\n"
+                                   "Tests ['`‘]ert-describe-test['’]\\.\n\\'")
+                                  (buffer-string)))))))))
+
+(ert-deftest ert-test-message-log-truncation ()
+  :tags '(:causes-redisplay)
+  (let ((test (make-ert-test
+               :body (lambda ()
+                       ;; Emacs would combine messages if we
+                       ;; generate the same message multiple
+                       ;; times.
+                       (message "a")
+                       (message "b")
+                       (message "c")
+                       (message "d")))))
+    (let (result)
+      (ert-with-buffer-renamed ("*Messages*")
+        (let ((message-log-max 2))
+          (setq result (ert-run-test test)))
+        (should (equal (with-current-buffer "*Messages*"
+                         (buffer-string))
+                       "c\nd\n")))
+      (should (equal (ert-test-result-messages result) "a\nb\nc\nd\n")))))
+
+(ert-deftest ert-test-builtin-message-log-flushing ()
+  "This test attempts to demonstrate that there is no way to
+force immediate truncation of the *Messages* buffer from Lisp
+\(and hence justifies the existence of
+`ert--force-message-log-buffer-truncation'): The only way that
+came to my mind was \(message \"\"), which doesn't have the
+desired effect."
+  :tags '(:causes-redisplay)
+  (ert-with-buffer-renamed ("*Messages*")
+    (with-current-buffer "*Messages*"
+      (should (equal (buffer-string) ""))
+      ;; We used to get sporadic failures in this test that involved
+      ;; a spurious newline at the beginning of the buffer, before
+      ;; the first message.  Below, we print a message and erase the
+      ;; buffer since this seems to eliminate the sporadic failures.
+      (message "foo")
+      (erase-buffer)
+      (should (equal (buffer-string) ""))
+      (let ((message-log-max 2))
+        (let ((message-log-max t))
+          (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 "")
+        (should (equal (buffer-string) "0\n1\n2\n3\n"))
+        (message "Test message")
+        (should (equal (buffer-string) "3\nTest message\n"))))))
+
+(ert-deftest ert-test-force-message-log-buffer-truncation ()
+  :tags '(:causes-redisplay)
+  (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)
+
+;;; ert-x-tests.el ends here
diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el
new file mode 100644
index 00000000000..96a68d1b9c1
--- /dev/null
+++ b/test/lisp/emacs-lisp/generator-tests.el
@@ -0,0 +1,284 @@
+;;; generator-tests.el --- Testing generators -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Daniel Colascione <dancol@dancol.org>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+(require 'generator)
+(require 'ert)
+(require 'cl-lib)
+
+(defun generator-list-subrs ()
+  (cl-loop for x being the symbols
+        when (and (fboundp x)
+                  (cps--special-form-p (symbol-function x)))
+        collect x))
+
+(defmacro cps-testcase (name &rest body)
+  "Perform a simple test of the continuation-transforming code.
+
+`cps-testcase' defines an ERT testcase called NAME that evaluates
+BODY twice: once using ordinary `eval' and once using
+lambda-generators.  The test ensures that the two forms produce
+identical output.
+"
+  `(progn
+     (ert-deftest ,name ()
+       (should
+        (equal
+         (funcall (lambda () ,@body))
+         (iter-next
+          (funcall
+           (iter-lambda () (iter-yield (progn ,@body))))))))
+     (ert-deftest ,(intern (format "%s-noopt" name)) ()
+       (should
+        (equal
+         (funcall (lambda () ,@body))
+         (iter-next
+          (funcall
+           (let ((cps-inhibit-atomic-optimization t))
+             (iter-lambda () (iter-yield (progn ,@body)))))))))))
+
+(put 'cps-testcase 'lisp-indent-function 1)
+
+(defvar *cps-test-i* nil)
+(defun cps-get-test-i ()
+  *cps-test-i*)
+
+(cps-testcase cps-simple-1 (progn 1 2 3))
+(cps-testcase cps-empty-progn (progn))
+(cps-testcase cps-inline-not-progn (inline 1 2 3))
+(cps-testcase cps-prog1-a (prog1 1 2 3))
+(cps-testcase cps-prog1-b (prog1 1))
+(cps-testcase cps-prog1-c (prog2 1 2 3))
+(cps-testcase cps-quote (progn 'hello))
+(cps-testcase cps-function (progn #'hello))
+
+(cps-testcase cps-and-fail (and 1 nil 2))
+(cps-testcase cps-and-succeed (and 1 2 3))
+(cps-testcase cps-and-empty (and))
+
+(cps-testcase cps-or-fallthrough (or nil 1 2))
+(cps-testcase cps-or-alltrue (or 1 2 3))
+(cps-testcase cps-or-empty (or))
+
+(cps-testcase cps-let* (let* ((i 10)) i))
+(cps-testcase cps-let*-shadow-empty (let* ((i 10)) (let (i) i)))
+(cps-testcase cps-let (let ((i 10)) i))
+(cps-testcase cps-let-shadow-empty (let ((i 10)) (let (i) i)))
+(cps-testcase cps-let-novars (let nil 42))
+(cps-testcase cps-let*-novars (let* nil 42))
+
+(cps-testcase cps-let-parallel
+  (let ((a 5) (b 6)) (let ((a b) (b a)) (list a b))))
+
+(cps-testcase cps-let*-parallel
+  (let* ((a 5) (b 6)) (let* ((a b) (b a)) (list a b))))
+
+(cps-testcase cps-while-dynamic
+  (setq *cps-test-i* 0)
+  (while (< *cps-test-i* 10)
+    (setf *cps-test-i* (+ *cps-test-i* 1)))
+  *cps-test-i*)
+
+(cps-testcase cps-while-lexical
+ (let* ((i 0) (j 10))
+   (while (< i 10)
+     (setf i (+ i 1))
+     (setf j (+ j (* i 10))))
+   j))
+
+(cps-testcase cps-while-incf
+ (let* ((i 0) (j 10))
+   (while (< i 10)
+     (cl-incf i)
+     (setf j (+ j (* i 10))))
+   j))
+
+(cps-testcase cps-dynbind
+ (setf *cps-test-i* 0)
+ (let* ((*cps-test-i* 5))
+   (cps-get-test-i)))
+
+(cps-testcase cps-nested-application
+ (+ (+ 3 5) 1))
+
+(cps-testcase cps-unwind-protect
+ (setf *cps-test-i* 0)
+ (unwind-protect
+     (setf *cps-test-i* 1)
+   (setf *cps-test-i* 2))
+ *cps-test-i*)
+
+(cps-testcase cps-catch-unused
+ (catch 'mytag 42))
+
+(cps-testcase cps-catch-thrown
+ (1+ (catch 'mytag
+       (throw 'mytag (+ 2 2)))))
+
+(cps-testcase cps-loop
+ (cl-loop for x from 1 to 10 collect x))
+
+(cps-testcase cps-loop-backquote
+ `(a b ,(cl-loop for x from 1 to 10 collect x) -1))
+
+(cps-testcase cps-if-branch-a
+ (if t 'abc))
+
+(cps-testcase cps-if-branch-b
+ (if t 'abc 'def))
+
+(cps-testcase cps-if-condition-fail
+ (if nil 'abc 'def))
+
+(cps-testcase cps-cond-empty
+ (cond))
+
+(cps-testcase cps-cond-atomi
+ (cond (42)))
+
+(cps-testcase cps-cond-complex
+ (cond (nil 22) ((1+ 1) 42) (t 'bad)))
+
+(put 'cps-test-error 'error-conditions '(cps-test-condition))
+
+(cps-testcase cps-condition-case
+  (condition-case
+      condvar
+      (signal 'cps-test-error 'test-data)
+    (cps-test-condition condvar)))
+
+(cps-testcase cps-condition-case-no-error
+  (condition-case
+      condvar
+      42
+    (cps-test-condition condvar)))
+
+(ert-deftest cps-generator-basic ()
+  (let* ((gen (iter-lambda ()
+                (iter-yield 1)
+                (iter-yield 2)
+                (iter-yield 3)
+                4))
+         (gen-inst (funcall gen)))
+    (should (eql (iter-next gen-inst) 1))
+    (should (eql (iter-next gen-inst) 2))
+    (should (eql (iter-next gen-inst) 3))
+
+    ;; should-error doesn't catch the generator-end condition (which
+    ;; isn't an error), so we write our own.
+    (let (errored)
+      (condition-case x
+          (iter-next gen-inst)
+        (iter-end-of-sequence
+         (setf errored (cdr x))))
+      (should (eql errored 4)))))
+
+(iter-defun mygenerator (i)
+  (iter-yield 1)
+  (iter-yield i)
+  (iter-yield 2))
+
+(ert-deftest cps-test-iter-do ()
+  (let (mylist)
+    (iter-do (x (mygenerator 4))
+      (push x mylist))
+    (should (equal mylist '(2 4 1)))))
+
+(iter-defun gen-using-yield-value ()
+  (let (f)
+    (setf f (iter-yield 42))
+    (iter-yield f)
+    -8))
+
+(ert-deftest cps-yield-value ()
+  (let ((it (gen-using-yield-value)))
+    (should (eql (iter-next it -1) 42))
+    (should (eql (iter-next it -1) -1))))
+
+(ert-deftest cps-loop ()
+  (should
+   (equal (cl-loop for x iter-by (mygenerator 42)
+             collect x)
+          '(1 42 2))))
+
+(iter-defun gen-using-yield-from ()
+  (let ((sub-iter (gen-using-yield-value)))
+    (iter-yield (1+ (iter-yield-from sub-iter)))))
+
+(ert-deftest cps-test-yield-from-works ()
+  (let ((it (gen-using-yield-from)))
+    (should (eql (iter-next it -1) 42))
+    (should (eql (iter-next it -1) -1))
+    (should (eql (iter-next it -1) -7))))
+
+(defvar cps-test-closed-flag nil)
+
+(ert-deftest cps-test-iter-close ()
+  (garbage-collect)
+  (let ((cps-test-closed-flag nil))
+    (let ((iter (funcall
+                 (iter-lambda ()
+                   (unwind-protect (iter-yield 1)
+                     (setf cps-test-closed-flag t))))))
+      (should (equal (iter-next iter) 1))
+      (should (not cps-test-closed-flag))
+      (iter-close iter)
+      (should cps-test-closed-flag))))
+
+(ert-deftest cps-test-iter-close-idempotent ()
+  (garbage-collect)
+  (let ((cps-test-closed-flag nil))
+    (let ((iter (funcall
+                 (iter-lambda ()
+                   (unwind-protect (iter-yield 1)
+                     (setf cps-test-closed-flag t))))))
+      (should (equal (iter-next iter) 1))
+      (should (not cps-test-closed-flag))
+      (iter-close iter)
+      (should cps-test-closed-flag)
+      (setf cps-test-closed-flag nil)
+      (iter-close iter)
+      (should (not cps-test-closed-flag)))))
+
+(ert-deftest cps-test-iter-cleanup-once-only ()
+  (let* ((nr-unwound 0)
+         (iter
+          (funcall (iter-lambda ()
+                     (unwind-protect
+                          (progn
+                            (iter-yield 1)
+                            (error "test")
+                            (iter-yield 2))
+                       (cl-incf nr-unwound))))))
+    (should (equal (iter-next iter) 1))
+    (should-error (iter-next iter))
+    (should (equal nr-unwound 1))))
+
+(iter-defun generator-with-docstring ()
+  "Documentation!"
+  (declare (indent 5))
+  nil)
+
+(ert-deftest cps-test-declarations-preserved ()
+  (should (equal (documentation 'generator-with-docstring) "Documentation!"))
+  (should (equal (get 'generator-with-docstring 'lisp-indent-function) 5)))
diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el
new file mode 100644
index 00000000000..65727dc3af5
--- /dev/null
+++ b/test/lisp/emacs-lisp/let-alist-tests.el
@@ -0,0 +1,91 @@
+;;; let-alist.el --- tests for file handling. -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+(require 'let-alist)
+
+(ert-deftest let-alist-surface-test ()
+  "Tests basic macro expansion for `let-alist'."
+  (should
+   (equal '(let ((symbol data))
+             (let ((.test-one (cdr (assq 'test-one symbol)))
+                   (.test-two (cdr (assq 'test-two symbol))))
+               (list .test-one .test-two
+                     .test-two .test-two)))
+          (cl-letf (((symbol-function #'make-symbol) (lambda (x) 'symbol)))
+            (macroexpand
+             '(let-alist data (list .test-one .test-two
+                                    .test-two .test-two))))))
+  (should
+   (equal
+    (let ((.external "ext")
+          (.external.too "et"))
+      (let-alist '((test-two . 0)
+                   (test-three . 1)
+                   (sublist . ((foo . 2)
+                               (bar . 3))))
+        (list .test-one .test-two .test-three
+              .sublist.foo .sublist.bar
+              ..external ..external.too)))
+    (list nil 0 1 2 3 "ext" "et"))))
+
+(ert-deftest let-alist-cons ()
+  (should
+   (equal
+    (let ((.external "ext")
+          (.external.too "et"))
+      (let-alist '((test-two . 0)
+                   (test-three . 1)
+                   (sublist . ((foo . 2)
+                               (bar . 3))))
+        (list `(, .test-one . , .test-two)
+              .sublist.bar ..external)))
+    (list '(nil . 0) 3 "ext"))))
+
+(defvar let-alist--test-counter 0
+  "Used to count number of times a function is called.")
+
+(ert-deftest let-alist-evaluate-once ()
+  "Check that the alist argument is only evaluated once."
+  (let ((let-alist--test-counter 0))
+    (should
+     (equal
+      (let-alist (list
+                  (cons 'test-two (cl-incf let-alist--test-counter))
+                  (cons 'test-three (cl-incf let-alist--test-counter)))
+        (list .test-one .test-two .test-two .test-three .cl-incf))
+      '(nil 1 1 2 nil)))))
+
+(ert-deftest let-alist-remove-dot ()
+  "Remove first dot from symbol."
+  (should (equal (let-alist--remove-dot 'hi) 'hi))
+  (should (equal (let-alist--remove-dot '.hi) 'hi))
+  (should (equal (let-alist--remove-dot '..hi) '.hi)))
+
+(ert-deftest let-alist-list-to-sexp ()
+  "Check that multiple dots are handled correctly."
+  (should (= 1 (eval (let-alist--list-to-sexp '(a b c d) ''((d (c (b (a . 1)))))))))
+  (should (equal (let-alist--access-sexp '.foo.bar.baz 'var)
+                 '(cdr (assq 'baz (cdr (assq 'bar (cdr (assq 'foo var))))))))
+  (should (equal (let-alist--access-sexp '..foo.bar.baz 'var) '.foo.bar.baz)))
+
+;;; let-alist.el ends here
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
new file mode 100644
index 00000000000..2a7fcc39d41
--- /dev/null
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -0,0 +1,331 @@
+;;; map-tests.el --- Tests for map.el  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <nicolas@petton.fr>
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for map.el
+
+;;; Code:
+
+(require 'ert)
+(require 'map)
+
+(defmacro with-maps-do (var &rest body)
+  "Successively bind VAR to an alist, vector and hash-table.
+Each map is built from the following alist data:
+'((0 . 3) (1 . 4) (2 . 5)).
+Evaluate BODY for each created map.
+
+\(fn (var map) body)"
+  (declare (indent 1) (debug t))
+  (let ((alist (make-symbol "alist"))
+        (vec (make-symbol "vec"))
+        (ht (make-symbol "ht")))
+   `(let ((,alist (list (cons 0 3)
+                        (cons 1 4)
+                        (cons 2 5)))
+          (,vec (vector 3 4 5))
+          (,ht (make-hash-table)))
+      (puthash 0 3 ,ht)
+      (puthash 1 4 ,ht)
+      (puthash 2 5 ,ht)
+      (dolist (,var (list ,alist ,vec ,ht))
+        ,@body))))
+
+(ert-deftest test-map-elt ()
+  (with-maps-do map
+    (should (= 3 (map-elt map 0)))
+    (should (= 4 (map-elt map 1)))
+    (should (= 5 (map-elt map 2)))
+    (should (null (map-elt map -1)))
+    (should (null (map-elt map 4)))))
+
+(ert-deftest test-map-elt-default ()
+  (with-maps-do map
+    (should (= 5 (map-elt map 7 5)))))
+
+(ert-deftest test-map-elt-with-nil-value ()
+  (should (null (map-elt '((a . 1)
+                           (b))
+                         'b
+                         '2))))
+
+(ert-deftest test-map-put ()
+  (with-maps-do map
+    (setf (map-elt map 2) 'hello)
+    (should (eq (map-elt map 2) 'hello)))
+  (with-maps-do map
+    (map-put map 2 'hello)
+    (should (eq (map-elt map 2) 'hello)))
+  (let ((ht (make-hash-table)))
+    (setf (map-elt ht 2) 'a)
+    (should (eq (map-elt ht 2)
+                'a)))
+  (let ((alist '((0 . a) (1 . b) (2 . c))))
+    (setf (map-elt alist 2) 'a)
+    (should (eq (map-elt alist 2)
+                'a)))
+  (let ((vec [3 4 5]))
+   (should-error (setf (map-elt vec 3) 6))))
+
+(ert-deftest test-map-put-return-value ()
+  (let ((ht (make-hash-table)))
+    (should (eq (map-put ht 'a 'hello) ht))))
+
+(ert-deftest test-map-delete ()
+  (with-maps-do map
+    (map-delete map 1)
+    (should (null (map-elt map 1))))
+  (with-maps-do map
+    (map-delete map -2)
+    (should (null (map-elt map -2)))))
+
+(ert-deftest test-map-delete-return-value ()
+  (let ((ht (make-hash-table)))
+    (should (eq (map-delete ht 'a) ht))))
+
+(ert-deftest test-map-nested-elt ()
+  (let ((vec [a b [c d [e f]]]))
+    (should (eq (map-nested-elt vec '(2 2 0)) 'e)))
+  (let ((alist '((a . 1)
+                 (b . ((c . 2)
+                       (d . 3)
+                       (e . ((f . 4)
+                             (g . 5))))))))
+    (should (eq (map-nested-elt alist '(b e f))
+                4)))
+  (let ((ht (make-hash-table)))
+    (setf (map-elt ht 'a) 1)
+    (setf (map-elt ht 'b) (make-hash-table))
+    (setf (map-elt (map-elt ht 'b) 'c) 2)
+    (should (eq (map-nested-elt ht '(b c))
+                2))))
+
+(ert-deftest test-map-nested-elt-default ()
+  (let ((vec [a b [c d]]))
+    (should (null (map-nested-elt vec '(2 3))))
+    (should (null (map-nested-elt vec '(2 1 1))))
+    (should (= 4 (map-nested-elt vec '(2 1 1) 4)))))
+
+(ert-deftest test-mapp ()
+  (should (mapp nil))
+  (should (mapp '((a . b) (c . d))))
+  (should (mapp '(a b c d)))
+  (should (mapp []))
+  (should (mapp [1 2 3]))
+  (should (mapp (make-hash-table)))
+  (should (mapp "hello"))
+  (should (not (mapp 1)))
+  (should (not (mapp 'hello))))
+
+(ert-deftest test-map-keys ()
+  (with-maps-do map
+    (should (equal (map-keys map) '(0 1 2))))
+  (should (null (map-keys nil)))
+  (should (null (map-keys []))))
+
+(ert-deftest test-map-values ()
+  (with-maps-do map
+    (should (equal (map-values map) '(3 4 5)))))
+
+(ert-deftest test-map-pairs ()
+  (with-maps-do map
+    (should (equal (map-pairs map) '((0 . 3)
+                                     (1 . 4)
+                                     (2 . 5))))))
+
+(ert-deftest test-map-length ()
+  (let ((ht (make-hash-table)))
+    (puthash 'a 1 ht)
+    (puthash 'b 2 ht)
+    (puthash 'c 3 ht)
+    (puthash 'd 4 ht)
+    (should (= 0 (map-length nil)))
+    (should (= 0 (map-length [])))
+    (should (= 0 (map-length (make-hash-table))))
+    (should (= 5 (map-length [0 1 2 3 4])))
+    (should (= 2 (map-length '((a . 1) (b . 2)))))
+    (should (= 4 (map-length ht)))))
+
+(ert-deftest test-map-copy ()
+  (with-maps-do map
+    (let ((copy (map-copy map)))
+      (should (equal (map-keys map) (map-keys copy)))
+      (should (equal (map-values map) (map-values copy)))
+      (should (not (eq map copy))))))
+
+(ert-deftest test-map-apply ()
+  (with-maps-do map
+    (should (equal (map-apply (lambda (k v) (cons (int-to-string k) v))
+                              map)
+                   '(("0" . 3) ("1" . 4) ("2" . 5)))))
+  (let ((vec [a b c]))
+    (should (equal (map-apply (lambda (k v) (cons (1+ k) v))
+                              vec)
+                   '((1 . a)
+                     (2 . b)
+                     (3 . c))))))
+
+(ert-deftest test-map-keys-apply ()
+  (with-maps-do map
+    (should (equal (map-keys-apply (lambda (k) (int-to-string k))
+                                   map)
+                   '("0" "1" "2"))))
+  (let ((vec [a b c]))
+    (should (equal (map-keys-apply (lambda (k) (1+ k))
+                                   vec)
+                   '(1 2 3)))))
+
+(ert-deftest test-map-values-apply ()
+  (with-maps-do map
+    (should (equal (map-values-apply (lambda (v) (1+ v))
+                                     map)
+                   '(4 5 6))))
+  (let ((vec [a b c]))
+    (should (equal (map-values-apply (lambda (v) (symbol-name v))
+                                     vec)
+                   '("a" "b" "c")))))
+
+(ert-deftest test-map-filter ()
+  (with-maps-do map
+    (should (equal (map-keys (map-filter (lambda (_k v)
+                                           (<= 4 v))
+                                         map))
+                   '(1 2)))
+    (should (null (map-filter (lambda (k _v)
+                                (eq 'd k))
+                              map))))
+  (should (null (map-filter (lambda (_k v)
+                              (eq 3 v))
+                            [1 2 4 5])))
+  (should (equal (map-filter (lambda (k _v)
+                               (eq 3 k))
+                             [1 2 4 5])
+                 '((3 . 5)))))
+
+(ert-deftest test-map-remove ()
+  (with-maps-do map
+    (should (equal (map-keys (map-remove (lambda (_k v)
+                                           (>= v 4))
+                                         map))
+                   '(0)))
+    (should (equal (map-keys (map-remove (lambda (k _v)
+                                           (eq 'd k))
+                                         map))
+                   (map-keys map))))
+  (should (equal (map-remove (lambda (_k v)
+                               (eq 3 v))
+                             [1 2 4 5])
+                 '((0 . 1)
+                   (1 . 2)
+                   (2 . 4)
+                   (3 . 5))))
+  (should (null (map-remove (lambda (k _v)
+                              (>= k 0))
+                            [1 2 4 5]))))
+
+(ert-deftest test-map-empty-p ()
+  (should (map-empty-p nil))
+  (should (not (map-empty-p '((a . b) (c . d)))))
+  (should (map-empty-p []))
+  (should (not (map-empty-p [1 2 3])))
+  (should (map-empty-p (make-hash-table)))
+  (should (not (map-empty-p "hello")))
+  (should (map-empty-p "")))
+
+(ert-deftest test-map-contains-key ()
+  (should (map-contains-key '((a . 1) (b . 2)) 'a))
+  (should (not (map-contains-key '((a . 1) (b . 2)) 'c)))
+  (should (map-contains-key '(("a" . 1)) "a"))
+  (should (not (map-contains-key '(("a" . 1)) "a" #'eq)))
+  (should (map-contains-key [a b c] 2))
+  (should (not (map-contains-key [a b c] 3))))
+
+(ert-deftest test-map-some ()
+  (with-maps-do map
+    (should (map-some (lambda (k _v)
+                        (eq 1 k))
+                      map))
+    (should-not (map-some (lambda (k _v)
+                            (eq 'd k))
+                          map)))
+  (let ((vec [a b c]))
+    (should (map-some (lambda (k _v)
+                        (> k 1))
+                      vec))
+    (should-not (map-some (lambda (k _v)
+                            (> k 3))
+                          vec))))
+
+(ert-deftest test-map-every-p ()
+  (with-maps-do map
+    (should (map-every-p (lambda (k _v)
+                           k)
+                         map))
+    (should (not (map-every-p (lambda (_k _v)
+                                nil)
+                              map))))
+  (let ((vec [a b c]))
+    (should (map-every-p (lambda (k _v)
+                           (>= k 0))
+                         vec))
+    (should (not (map-every-p (lambda (k _v)
+                                (> k 3))
+                              vec)))))
+
+(ert-deftest test-map-into ()
+  (let* ((alist '((a . 1) (b . 2)))
+         (ht (map-into alist 'hash-table)))
+    (should (hash-table-p ht))
+    (should (equal (map-into (map-into alist 'hash-table) 'list)
+                   alist))
+    (should (listp (map-into ht 'list)))
+    (should (equal (map-keys (map-into (map-into ht 'list) 'hash-table))
+                   (map-keys ht)))
+    (should (equal (map-values (map-into (map-into ht 'list) 'hash-table))
+                   (map-values ht)))
+    (should (null (map-into nil 'list)))
+    (should (map-empty-p (map-into nil 'hash-table)))
+    (should-error (map-into [1 2 3] 'string))))
+
+(ert-deftest test-map-let ()
+  (map-let (foo bar baz) '((foo . 1) (bar . 2))
+    (should (= foo 1))
+    (should (= bar 2))
+    (should (null baz)))
+  (map-let (('foo a)
+            ('bar b)
+            ('baz c))
+      '((foo . 1) (bar . 2))
+    (should (= a 1))
+    (should (= b 2))
+    (should (null c))))
+
+(ert-deftest test-map-merge-with ()
+  (should (equal (map-merge-with 'list #'+
+                                 '((1 . 2))
+                                 '((1 . 3) (2 . 4))
+                                 '((1 . 1) (2 . 5) (3 . 0)))
+                 '((3 . 0) (2 . 9) (1 . 6)))))
+
+(provide 'map-tests)
+;;; map-tests.el ends here
diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el
new file mode 100644
index 00000000000..e1d125de4af
--- /dev/null
+++ b/test/lisp/emacs-lisp/nadvice-tests.el
@@ -0,0 +1,211 @@
+;;; advice-tests.el --- Test suite for the new advice thingy.
+
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest advice-tests-nadvice ()
+  "Test nadvice code."
+  (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
+  (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 2)))
+  (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
+  (defun sm-test1 (x) (+ x 4))
+  (should (equal (sm-test1 6) 20))
+  (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 2)))
+  (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 (get 'sm-test1 'defalias-fset-function) nil))
+
+  (advice-add 'sm-test3 :around
+              (lambda (f &rest args) `(toto ,(apply f args)))
+              '((name . wrap-with-toto)))
+  (defmacro sm-test3 (x) `(call-test3 ,x))
+  (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))))
+
+(ert-deftest advice-tests-macroaliases ()
+  "Test nadvice code on aliases to macros."
+  (defmacro sm-test1 (a) `(list ',a))
+  (defalias 'sm-test1-alias 'sm-test1)
+  (should (equal (macroexpand '(sm-test1-alias 5)) '(list '5)))
+  (advice-add 'sm-test1-alias :around
+              (lambda (f &rest args) `(cons 1 ,(apply f args))))
+  (should (equal (macroexpand '(sm-test1-alias 5)) '(cons 1 (list '5))))
+  (defmacro sm-test1 (a) `(list 0 ',a))
+  (should (equal (macroexpand '(sm-test1-alias 5)) '(cons 1 (list 0 '5)))))
+
+
+(ert-deftest advice-tests-advice ()
+  "Test advice code."
+  (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)))
+  (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))
+
+  (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))
+  (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))))
+
+  ;; This used to signal an error (bug#12858).
+  (autoload 'sm-test6 "foo")
+  (defadvice sm-test6 (around test activate)
+    ad-do-it))
+
+(ert-deftest advice-tests-combination ()
+  "Combining old style and new style advices."
+  (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)))
+  (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)))
+
+(ert-deftest advice-test-called-interactively-p ()
+  "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-test-called-interactively-p-around ()
+  "Check interaction between around advice and called-interactively-p.
+
+This tests the currently broken case of the innermost advice to a
+function being an around advice."
+  :expected-result :failed
+  (defun sm-test7.2 () (interactive) (cons 1 (called-interactively-p)))
+  (advice-add 'sm-test7.2 :around
+              (lambda (f &rest args)
+                (list (cons 1 (called-interactively-p)) (apply f args))))
+  (should (equal (sm-test7.2) '((1 . nil) (1 . nil))))
+  (should (equal (call-interactively 'sm-test7.2) '((1 . t) (1 . t)))))
+
+(ert-deftest advice-test-called-interactively-p-filter-args ()
+  "Check interaction between filter-args advice and called-interactively-p."
+  :expected-result :failed
+  (defun sm-test7.3 () (interactive) (cons 1 (called-interactively-p)))
+  (advice-add 'sm-test7.3 :filter-args #'list)
+  (should (equal (sm-test7.3) '(1 . nil)))
+  (should (equal (call-interactively 'sm-test7.3) '(1 . t))))
+
+(ert-deftest advice-test-call-interactively ()
+  "Check interaction between advice on call-interactively and called-interactively-p."
+  (defun sm-test7.4 () (interactive) (cons 1 (called-interactively-p)))
+  (let ((old (symbol-function 'call-interactively)))
+    (unwind-protect
+        (progn
+          (advice-add 'call-interactively :before #'ignore)
+          (should (equal (sm-test7.4) '(1 . nil)))
+          (should (equal (call-interactively 'sm-test7.4) '(1 . t))))
+      (advice-remove 'call-interactively #'ignore)
+      (should (eq (symbol-function 'call-interactively) old)))))
+
+(ert-deftest advice-test-interactive ()
+  "Check handling of interactive spec."
+  (defun sm-test8 (a) (interactive "p") a)
+  (defadvice sm-test8 (before adv1 activate) nil)
+  (defadvice sm-test8 (before adv2 activate) (interactive "P") nil)
+  (should (equal (interactive-form 'sm-test8) '(interactive "P"))))
+
+(ert-deftest advice-test-preactivate ()
+  (should (equal (null (get 'sm-test9 'defalias-fset-function)) t))
+  (defun sm-test9 (a) (interactive "p") a)
+  (should (equal (null (get 'sm-test9 'defalias-fset-function)) t))
+  (defadvice sm-test9 (before adv1 pre act protect compile) nil)
+  (should (equal (null (get 'sm-test9 'defalias-fset-function)) nil))
+  (defadvice sm-test9 (before adv2 pre act protect compile)
+    (interactive "P") nil)
+  (should (equal (interactive-form 'sm-test9) '(interactive "P"))))
+
+(ert-deftest advice-test-multiples ()
+  (let ((sm-test10 (lambda (a) (+ a 10)))
+        (sm-advice (lambda (x) (if (consp x) (list (* 5 (car x))) (* 4 x)))))
+    (should (equal (funcall sm-test10 5) 15))
+    (add-function :filter-args (var sm-test10) sm-advice)
+    (should (advice-function-member-p sm-advice sm-test10))
+    (should (equal (funcall sm-test10 5) 35))
+    (add-function :filter-return (var sm-test10) sm-advice)
+    (should (equal (funcall sm-test10 5) 60))
+    ;; Make sure we can add multiple times the same function, under the
+    ;; condition that they have different `name' properties.
+    (add-function :filter-args (var sm-test10) sm-advice '((name . "args")))
+    (should (equal (funcall sm-test10 5) 140))
+    (remove-function (var sm-test10) "args")
+    (should (equal (funcall sm-test10 5) 60))
+    (add-function :filter-args (var sm-test10) sm-advice '((name . "args")))
+    (add-function :filter-return (var sm-test10) sm-advice '((name . "ret")))
+    (should (equal (funcall sm-test10 5) 560))
+    ;; Make sure that if we specify to remove a function that was added
+    ;; multiple times, they are all removed, rather than removing only some
+    ;; arbitrary subset of them.
+    (remove-function (var sm-test10) sm-advice)
+    (should (equal (funcall sm-test10 5) 15))))
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; advice-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el
new file mode 100644
index 00000000000..de41c3bc8e4
--- /dev/null
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -0,0 +1,611 @@
+;;; package-test.el --- Tests for the Emacs package system
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+
+;; Author: Daniel Hackney <dan@haxney.org>
+;; Version: 1.0
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; You may want to run this from a separate Emacs instance from your
+;; main one, because a bug in the code below could mess with your
+;; installed packages.
+
+;; Run this in a clean Emacs session using:
+;;
+;;     $ emacs -Q --batch -L . -l package-test.el -l ert -f ert-run-tests-batch-and-exit
+
+;;; Code:
+
+(require 'package)
+(require 'ert)
+(require 'cl-lib)
+
+(setq package-menu-async nil)
+
+(defvar package-test-user-dir nil
+  "Directory to use for installing packages during testing.")
+
+(defvar package-test-file-dir (file-name-directory (or load-file-name
+                                                       buffer-file-name))
+  "Directory of the actual \"package-test.el\" file.")
+
+(defvar simple-single-desc
+  (package-desc-create :name 'simple-single
+                       :version '(1 3)
+                       :summary "A single-file package with no dependencies"
+                       :kind 'single
+                       :extras '((:authors ("J. R. Hacker" . "jrh@example.com"))
+                                 (:maintainer "J. R. Hacker" . "jrh@example.com")
+                                 (:url . "http://doodles.au")))
+  "Expected `package-desc' parsed from simple-single-1.3.el.")
+
+(defvar simple-depend-desc
+  (package-desc-create :name 'simple-depend
+                       :version '(1 0)
+                       :summary "A single-file package with a dependency."
+                       :kind 'single
+                       :reqs '((simple-single (1 3)))
+                       :extras '((:authors ("J. R. Hacker" . "jrh@example.com"))
+                                 (:maintainer "J. R. Hacker" . "jrh@example.com")))
+  "Expected `package-desc' parsed from simple-depend-1.0.el.")
+
+(defvar multi-file-desc
+  (package-desc-create :name 'multi-file
+                       :version '(0 2 3)
+                       :summary "Example of a multi-file tar package"
+                       :kind 'tar
+                       :extras '((:url . "http://puddles.li")))
+  "Expected `package-desc' from \"multi-file-0.2.3.tar\".")
+
+(defvar new-pkg-desc
+  (package-desc-create :name 'new-pkg
+                       :version '(1 0)
+                       :kind 'single)
+  "Expected `package-desc' parsed from new-pkg-1.0.el.")
+
+(defvar simple-depend-desc-1
+  (package-desc-create :name 'simple-depend-1
+                       :version '(1 0)
+                       :summary "A single-file package with a dependency."
+                       :kind 'single
+                       :reqs '((simple-depend (1 0))
+                               (multi-file (0 1))))
+  "`package-desc' used for testing dependencies.")
+
+(defvar simple-depend-desc-2
+  (package-desc-create :name 'simple-depend-2
+                       :version '(1 0)
+                       :summary "A single-file package with a dependency."
+                       :kind 'single
+                       :reqs '((simple-depend-1 (1 0))
+                               (multi-file (0 1))))
+  "`package-desc' used for testing dependencies.")
+
+(defvar package-test-data-dir (expand-file-name "data/package" package-test-file-dir)
+  "Base directory of package test files.")
+
+(defvar package-test-fake-contents-file
+  (expand-file-name "archive-contents" package-test-data-dir)
+  "Path to a static copy of \"archive-contents\".")
+
+(cl-defmacro with-package-test ((&optional &key file
+                                           basedir
+                                           install
+                                           location
+                                           update-news
+                                           upload-base)
+                                &rest body)
+  "Set up temporary locations and variables for testing."
+  (declare (indent 1))
+  `(let* ((package-test-user-dir (make-temp-file "pkg-test-user-dir-" t))
+          (process-environment (cons (format "HOME=%s" package-test-user-dir)
+                                     process-environment))
+          (package-user-dir package-test-user-dir)
+          (package-archives `(("gnu" . ,(or ,location package-test-data-dir))))
+          (default-directory package-test-file-dir)
+          abbreviated-home-dir
+          package--initialized
+          package-alist
+          ,@(if update-news
+                '(package-update-news-on-upload t)
+              (list (cl-gensym)))
+          ,@(if upload-base
+                '((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t))
+                  (package-archive-upload-base package-test-archive-upload-base))
+              (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind nil
+     (let ((buf (get-buffer "*Packages*")))
+       (when (buffer-live-p buf)
+         (kill-buffer buf)))
+     (unwind-protect
+         (progn
+           ,(if basedir `(cd ,basedir))
+           (unless (file-directory-p package-user-dir)
+             (mkdir package-user-dir))
+           (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest r) t))
+                     ((symbol-function 'y-or-n-p)    (lambda (&rest r) t)))
+             ,@(when install
+                 `((package-initialize)
+                   (package-refresh-contents)
+                   (mapc 'package-install ,install)))
+             (with-temp-buffer
+               ,(if file
+                    `(insert-file-contents ,file))
+               ,@body)))
+
+       (when (file-directory-p package-test-user-dir)
+         (delete-directory package-test-user-dir t))
+
+       (when (and (boundp 'package-test-archive-upload-base)
+                  (file-directory-p package-test-archive-upload-base))
+         (delete-directory package-test-archive-upload-base t)))))
+
+(defmacro with-fake-help-buffer (&rest body)
+  "Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer."
+  `(with-temp-buffer
+    (help-mode)
+    ;; Trick `help-buffer' into using the temp buffer.
+    (let ((help-xref-following t))
+      ,@body)))
+
+(defun package-test-strip-version (dir)
+  (replace-regexp-in-string "-pkg\\.el\\'" "" (package--description-file dir)))
+
+(defun package-test-suffix-matches (base suffix-list)
+  "Return file names matching BASE concatenated with each item in SUFFIX-LIST"
+  (cl-mapcan
+   '(lambda (item) (file-expand-wildcards (concat base item)))
+   suffix-list))
+
+(defvar tar-parse-info)
+(declare-function tar-header-name "tar-mode" (cl-x) t) ; defstruct
+
+(defun package-test-search-tar-file (filename)
+  "Search the current buffer's `tar-parse-info' variable for FILENAME.
+
+Must called from within a `tar-mode' buffer."
+  (cl-dolist (header tar-parse-info)
+    (let ((tar-name (tar-header-name header)))
+      (when (string= tar-name filename)
+        (cl-return t)))))
+
+(defun package-test-desc-version-string (desc)
+  "Return the package version as a string."
+  (package-version-join (package-desc-version desc)))
+
+(ert-deftest package-test-desc-from-buffer ()
+  "Parse an elisp buffer to get a `package-desc' object."
+  (with-package-test (:basedir "data/package" :file "simple-single-1.3.el")
+    (should (equal (package-buffer-info) simple-single-desc)))
+  (with-package-test (:basedir "data/package" :file "simple-depend-1.0.el")
+    (should (equal (package-buffer-info) simple-depend-desc)))
+  (with-package-test (:basedir "data/package"
+                               :file "multi-file-0.2.3.tar")
+    (tar-mode)
+    (should (equal (package-tar-file-info) multi-file-desc))))
+
+(ert-deftest package-test-install-single ()
+  "Install a single file without using an archive."
+  (with-package-test (:basedir "data/package" :file "simple-single-1.3.el")
+    (should (package-install-from-buffer))
+    (package-initialize)
+    (should (package-installed-p 'simple-single))
+    ;; Check if we properly report an "already installed".
+    (package-install 'simple-single)
+    (with-current-buffer "*Messages*"
+      (should (string-match "^[`‘']simple-single[’'] is already installed\n?\\'"
+                            (buffer-string))))
+    (should (package-installed-p 'simple-single))
+    (let* ((simple-pkg-dir (file-name-as-directory
+                            (expand-file-name
+                             "simple-single-1.3"
+                             package-test-user-dir)))
+           (autoloads-file (expand-file-name "simple-single-autoloads.el"
+                                             simple-pkg-dir)))
+      (should (file-directory-p simple-pkg-dir))
+      (with-temp-buffer
+        (insert-file-contents (expand-file-name "simple-single-pkg.el"
+                                                simple-pkg-dir))
+        (should (string= (buffer-string)
+                         (concat ";;; -*- no-byte-compile: t -*-\n"
+                                 "(define-package \"simple-single\" \"1.3\" "
+                                 "\"A single-file package "
+                                 "with no dependencies\" 'nil "
+                                 ":authors '((\"J. R. Hacker\" . \"jrh@example.com\")) "
+                                 ":maintainer '(\"J. R. Hacker\" . \"jrh@example.com\") "
+                                 ":url \"http://doodles.au\""
+                                 ")\n"))))
+      (should (file-exists-p autoloads-file))
+      (should-not (get-file-buffer autoloads-file)))))
+
+(ert-deftest package-test-install-dependency ()
+  "Install a package which includes a dependency."
+  (with-package-test ()
+    (package-initialize)
+    (package-refresh-contents)
+    (package-install 'simple-depend)
+    (should (package-installed-p 'simple-single))
+    (should (package-installed-p 'simple-depend))))
+
+(ert-deftest package-test-install-two-dependencies ()
+  "Install a package which includes a dependency."
+  (with-package-test ()
+    (package-initialize)
+    (package-refresh-contents)
+    (package-install 'simple-two-depend)
+    (should (package-installed-p 'simple-single))
+    (should (package-installed-p 'simple-depend))
+    (should (package-installed-p 'simple-two-depend))))
+
+(ert-deftest package-test-refresh-contents ()
+  "Parse an \"archive-contents\" file."
+  (with-package-test ()
+    (package-initialize)
+    (package-refresh-contents)
+    (should (eq 4 (length package-archive-contents)))))
+
+(ert-deftest package-test-install-single-from-archive ()
+  "Install a single package from a package archive."
+  (with-package-test ()
+    (package-initialize)
+    (package-refresh-contents)
+    (package-install 'simple-single)))
+
+(ert-deftest package-test-install-prioritized ()
+  "Install a lower version from a higher-prioritized archive."
+  (with-package-test ()
+    (let* ((newer-version (expand-file-name "data/package/newer-versions"
+                                            package-test-file-dir))
+           (package-archives `(("older" . ,package-test-data-dir)
+                               ("newer" . ,newer-version)))
+           (package-archive-priorities '(("older" . 100))))
+
+      (package-initialize)
+      (package-refresh-contents)
+      (package-install 'simple-single)
+
+      (let ((installed (cadr (assq 'simple-single package-alist))))
+        (should (version-list-= '(1 3)
+                                (package-desc-version installed)))))))
+
+(ert-deftest package-test-install-multifile ()
+  "Check properties of the installed multi-file package."
+  (with-package-test (:basedir "data/package" :install '(multi-file))
+    (let ((autoload-file
+           (expand-file-name "multi-file-autoloads.el"
+                             (expand-file-name
+                              "multi-file-0.2.3"
+                              package-test-user-dir)))
+          (installed-files '("dir" "multi-file.info" "multi-file-sub.elc"
+                             "multi-file-autoloads.el" "multi-file.elc"))
+          (autoload-forms '("^(defvar multi-file-custom-var"
+                            "^(custom-autoload 'multi-file-custom-var"
+                            "^(autoload 'multi-file-mode"))
+          (pkg-dir (file-name-as-directory
+                    (expand-file-name
+                     "multi-file-0.2.3"
+                     package-test-user-dir))))
+      (package-refresh-contents)
+      (should (package-installed-p 'multi-file))
+      (with-temp-buffer
+        (insert-file-contents-literally autoload-file)
+        (dolist (fn installed-files)
+          (should (file-exists-p (expand-file-name fn pkg-dir))))
+        (dolist (re autoload-forms)
+          (goto-char (point-min))
+          (should (re-search-forward re nil t)))))))
+
+(ert-deftest package-test-update-listing ()
+  "Ensure installed package status is updated."
+  (with-package-test ()
+    (let ((buf (package-list-packages)))
+      (search-forward-regexp "^ +simple-single")
+      (package-menu-mark-install)
+      (package-menu-execute)
+      (run-hooks 'post-command-hook)
+      (should (package-installed-p 'simple-single))
+      (switch-to-buffer "*Packages*")
+      (goto-char (point-min))
+      (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
+      (goto-char (point-min))
+      (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))
+      (kill-buffer buf))))
+
+(ert-deftest package-test-update-archives ()
+  "Test updating package archives."
+  (with-package-test ()
+    (let ((buf (package-list-packages)))
+      (package-menu-refresh)
+      (search-forward-regexp "^ +simple-single")
+      (package-menu-mark-install)
+      (package-menu-execute)
+      (should (package-installed-p 'simple-single))
+      (let ((package-test-data-dir
+             (expand-file-name "data/package/newer-versions" package-test-file-dir)))
+        (setq package-archives `(("gnu" . ,package-test-data-dir)))
+        (package-menu-refresh)
+
+        ;; New version should be available and old version should be installed
+        (goto-char (point-min))
+        (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+available" nil t))
+        (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
+
+        (goto-char (point-min))
+        (should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t))
+
+        (package-menu-mark-upgrades)
+        (package-menu-execute)
+        (package-menu-refresh)
+        (should (package-installed-p 'simple-single '(1 4)))))))
+
+(ert-deftest package-test-update-archives-async ()
+  "Test updating package archives asynchronously."
+  (skip-unless (executable-find "python2"))
+  ;; For some reason this test doesn't work reliably on hydra.nixos.org.
+  (skip-unless (not (getenv "NIX_STORE")))
+  (with-package-test (:basedir
+                      package-test-data-dir
+                      :location "http://0.0.0.0:8000/")
+    (let* ((package-menu-async t)
+           (process (start-process
+                     "package-server" "package-server-buffer"
+                     (executable-find "python2")
+                     (expand-file-name "package-test-server.py"))))
+      (unwind-protect
+          (progn
+            (list-packages)
+            (should package--downloads-in-progress)
+            (should mode-line-process)
+            (should-not
+             (with-timeout (10 'timeout)
+               (while package--downloads-in-progress
+                 (accept-process-output nil 1))
+               nil))
+            ;; If the server process died, there's some non-Emacs problem.
+            ;; Eg maybe the port was already in use.
+            (skip-unless (process-live-p process))
+            (goto-char (point-min))
+            (should
+             (search-forward-regexp "^ +simple-single" nil t)))
+        (if (process-live-p process) (kill-process process))))))
+
+(ert-deftest package-test-describe-package ()
+  "Test displaying help for a package."
+
+  (require 'finder-inf)
+  ;; Built-in
+  (with-fake-help-buffer
+   (describe-package '5x5)
+   (goto-char (point-min))
+   (should (search-forward "5x5 is a built-in package." nil t))
+   ;; Don't assume the descriptions are in any particular order.
+   (save-excursion (should (search-forward "Status: Built-in." nil t)))
+   (save-excursion (should (search-forward "Summary: simple little puzzle game" nil t)))
+   (should (search-forward "The aim of 5x5" nil t)))
+
+  ;; Installed
+  (with-package-test ()
+    (package-initialize)
+    (package-refresh-contents)
+    (package-install 'simple-single)
+    (with-fake-help-buffer
+     (describe-package 'simple-single)
+     (goto-char (point-min))
+     (should (search-forward "simple-single is an installed package." nil t))
+     (save-excursion (should (re-search-forward "Status: Installed in ['`‘]simple-single-1.3/['’] (unsigned)." nil t)))
+     (save-excursion (should (search-forward "Version: 1.3" nil t)))
+     (save-excursion (should (search-forward "Summary: A single-file package with no dependencies" nil t)))
+     (save-excursion (should (search-forward "Homepage: http://doodles.au" nil t)))
+     (save-excursion (should (re-search-forward "Keywords: \\[?frobnicate\\]?" nil t)))
+     ;; No description, though. Because at this point we don't know
+     ;; what archive the package originated from, and we don't have
+     ;; its readme file saved.
+     )))
+
+(ert-deftest package-test-describe-non-installed-package ()
+  "Test displaying of the readme for non-installed package."
+
+  (with-package-test ()
+    (package-initialize)
+    (package-refresh-contents)
+    (with-fake-help-buffer
+     (describe-package 'simple-single)
+     (goto-char (point-min))
+     (should (search-forward "Homepage: http://doodles.au" nil t))
+     (should (search-forward "This package provides a minor mode to frobnicate"
+                             nil t)))))
+
+(ert-deftest package-test-describe-non-installed-multi-file-package ()
+  "Test displaying of the readme for non-installed multi-file package."
+
+  (with-package-test ()
+    (package-initialize)
+    (package-refresh-contents)
+    (with-fake-help-buffer
+     (describe-package 'multi-file)
+     (goto-char (point-min))
+     (should (search-forward "Homepage: http://puddles.li" nil t))
+     (should (search-forward "This is a bare-bones readme file for the multi-file"
+                             nil t)))))
+
+(ert-deftest package-test-signed ()
+  "Test verifying package signature."
+  (skip-unless (ignore-errors
+		 (let ((homedir (make-temp-file "package-test" t)))
+		   (unwind-protect
+		       (let ((process-environment
+			      (cons (format "HOME=%s" homedir)
+				    process-environment)))
+			 (epg-check-configuration (epg-configuration))
+			 t)
+		     (delete-directory homedir t)))))
+  (let* ((keyring (expand-file-name "key.pub" package-test-data-dir))
+	 (package-test-data-dir
+	   (expand-file-name "data/package/signed" package-test-file-dir)))
+    (with-package-test ()
+      (package-initialize)
+      (package-import-keyring keyring)
+      (package-refresh-contents)
+      (should (package-install 'signed-good))
+      (should-error (package-install 'signed-bad))
+      ;; Check if the installed package status is updated.
+      (let ((buf (package-list-packages)))
+	(package-menu-refresh)
+	(should (re-search-forward
+		 "^\\s-+signed-good\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-"
+		 nil t))
+	(should (string-equal (match-string-no-properties 1) "1.0"))
+	(should (string-equal (match-string-no-properties 2) "installed")))
+      ;; Check if the package description is updated.
+      (with-fake-help-buffer
+       (describe-package 'signed-good)
+       (goto-char (point-min))
+       (should (re-search-forward "signed-good is an? \\(\\S-+\\) package." nil t))
+       (should (string-equal (match-string-no-properties 1) "installed"))
+       (should (re-search-forward
+		"Status: Installed in ['`‘]signed-good-1.0/['’]."
+		nil t))))))
+
+
+
+;;; Tests for package-x features.
+
+(require 'package-x)
+
+(defvar package-x-test--single-archive-entry-1-3
+  (cons 'simple-single
+        (package-make-ac-desc '(1 3) nil
+                              "A single-file package with no dependencies"
+                              'single
+                              '((:authors ("J. R. Hacker" . "jrh@example.com"))
+                                (:maintainer "J. R. Hacker" . "jrh@example.com")
+                                (:url . "http://doodles.au"))))
+  "Expected contents of the archive entry from the \"simple-single\" package.")
+
+(defvar package-x-test--single-archive-entry-1-4
+  (cons 'simple-single
+        (package-make-ac-desc '(1 4) nil
+                              "A single-file package with no dependencies"
+                              'single
+                              '((:authors ("J. R. Hacker" . "jrh@example.com"))
+                                (:maintainer "J. R. Hacker" . "jrh@example.com"))))
+  "Expected contents of the archive entry from the updated \"simple-single\" package.")
+
+(ert-deftest package-x-test-upload-buffer ()
+  "Test creating an \"archive-contents\" file"
+  (with-package-test (:basedir "data/package"
+                               :file "simple-single-1.3.el"
+                               :upload-base t)
+    (package-upload-buffer)
+    (should (file-exists-p (expand-file-name "archive-contents"
+                                             package-archive-upload-base)))
+    (should (file-exists-p (expand-file-name "simple-single-1.3.el"
+                                             package-archive-upload-base)))
+    (should (file-exists-p (expand-file-name "simple-single-readme.txt"
+                                             package-archive-upload-base)))
+
+    (let (archive-contents)
+      (with-temp-buffer
+        (insert-file-contents
+         (expand-file-name "archive-contents"
+                           package-archive-upload-base))
+        (setq archive-contents
+              (package-read-from-string
+               (buffer-substring (point-min) (point-max)))))
+      (should (equal archive-contents
+                     (list 1 package-x-test--single-archive-entry-1-3))))))
+
+(ert-deftest package-x-test-upload-new-version ()
+  "Test uploading a new version of a package"
+  (with-package-test (:basedir "data/package"
+                               :file "simple-single-1.3.el"
+                               :upload-base t)
+    (package-upload-buffer)
+    (with-temp-buffer
+      (insert-file-contents "newer-versions/simple-single-1.4.el")
+      (package-upload-buffer))
+
+    (let (archive-contents)
+      (with-temp-buffer
+        (insert-file-contents
+         (expand-file-name "archive-contents"
+                           package-archive-upload-base))
+        (setq archive-contents
+              (package-read-from-string
+               (buffer-substring (point-min) (point-max)))))
+      (should (equal archive-contents
+                     (list 1 package-x-test--single-archive-entry-1-4))))))
+
+(ert-deftest package-test-get-deps ()
+  "Test `package--get-deps' with complex structures."
+  (let ((package-alist
+         (mapcar (lambda (p) (list (package-desc-name p) p))
+           (list simple-single-desc
+                 simple-depend-desc
+                 multi-file-desc
+                 new-pkg-desc
+                 simple-depend-desc-1
+                 simple-depend-desc-2))))
+    (should
+     (equal (package--get-deps 'simple-depend)
+            '(simple-single)))
+    (should
+     (equal (package--get-deps 'simple-depend 'indirect)
+            nil))
+    (should
+     (equal (package--get-deps 'simple-depend 'direct)
+            '(simple-single)))
+    (should
+     (equal (package--get-deps 'simple-depend-2)
+            '(simple-depend-1 multi-file simple-depend simple-single)))
+    (should
+     (equal (package--get-deps 'simple-depend-2 'indirect)
+            '(simple-depend multi-file simple-single)))
+    (should
+     (equal (package--get-deps 'simple-depend-2 'direct)
+            '(simple-depend-1 multi-file)))))
+
+(ert-deftest package-test-sort-by-dependence ()
+  "Test `package--sort-by-dependence' with complex structures."
+  (let ((package-alist
+         (mapcar (lambda (p) (list (package-desc-name p) p))
+           (list simple-single-desc
+                 simple-depend-desc
+                 multi-file-desc
+                 new-pkg-desc
+                 simple-depend-desc-1
+                 simple-depend-desc-2)))
+        (delete-list
+         (list simple-single-desc
+               simple-depend-desc
+               multi-file-desc
+               new-pkg-desc
+               simple-depend-desc-1
+               simple-depend-desc-2)))
+    (should
+     (equal (package--sort-by-dependence delete-list)
+            (list simple-depend-desc-2 simple-depend-desc-1 new-pkg-desc
+                  multi-file-desc simple-depend-desc simple-single-desc)))
+    (should
+     (equal (package--sort-by-dependence (reverse delete-list))
+            (list new-pkg-desc simple-depend-desc-2 simple-depend-desc-1
+                  multi-file-desc simple-depend-desc simple-single-desc)))))
+
+(provide 'package-test)
+
+;;; package-test.el ends here
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
new file mode 100644
index 00000000000..701bcccc0e6
--- /dev/null
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -0,0 +1,74 @@
+;;; pcase-tests.el --- Test suite for pcase macro.
+
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+
+(ert-deftest pcase-tests-base ()
+  "Test pcase code."
+  (should (equal (pcase '(1 . 2) ((app car '2) 6) ((app car '1) 5)) 5)))
+
+(ert-deftest pcase-tests-bugs ()
+  (should (equal (pcase '(2 . 3)        ;bug#18554
+                   (`(,hd . ,(and (pred atom) tl)) (list hd tl))
+                   ((pred consp) nil))
+                 '(2 3))))
+
+(pcase-defmacro pcase-tests-plus (pat n)
+  `(app (lambda (v) (- v ,n)) ,pat))
+
+(ert-deftest pcase-tests-macro ()
+  (should (equal (pcase 5 ((pcase-tests-plus x 3) x)) 2)))
+
+(defun pcase-tests-grep (fname exp)
+  (when (consp exp)
+    (or (eq fname (car exp))
+        (cl-some (lambda (exp) (pcase-tests-grep fname exp)) (cdr exp)))))
+
+(ert-deftest pcase-tests-tests ()
+  (should (pcase-tests-grep 'memq '(or (+ 2 3) (memq x y))))
+  (should-not (pcase-tests-grep 'memq '(or (+ 2 3) (- x y)))))
+
+(ert-deftest pcase-tests-member ()
+  (should (pcase-tests-grep
+           'memq (macroexpand-all '(pcase x ((or 1 2 3) body)))))
+  (should (pcase-tests-grep
+           'member (macroexpand-all '(pcase x ((or '"a" '2 '3) body)))))
+  (should-not (pcase-tests-grep
+               'memq (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
+  (let ((exp (macroexpand-all
+                      '(pcase x
+                         ("a" body1)
+                         (2 body2)
+                         ((or "a" 2 3) body)))))
+    (should-not (pcase-tests-grep 'memq exp))
+    (should-not (pcase-tests-grep 'member exp))))
+
+(ert-deftest pcase-tests-vectors ()
+  (should (equal (pcase [1 2] (`[,x] 1) (`[,x ,y] (+ x y))) 3)))
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; pcase-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/regexp-opt-tests.el b/test/lisp/emacs-lisp/regexp-opt-tests.el
new file mode 100644
index 00000000000..ee177b3e2e9
--- /dev/null
+++ b/test/lisp/emacs-lisp/regexp-opt-tests.el
@@ -0,0 +1,33 @@
+;;; regexp-tests.el --- Test suite for regular expression handling.
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords:       internal
+;; Human-Keywords: internal
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'regexp-opt)
+
+(ert-deftest regexp-test-regexp-opt ()
+  "Test the `compilation-error-regexp-alist' regexps.
+The test data is in `compile-tests--test-regexps-data'."
+  (should (string-match (regexp-opt-charset '(?^)) "a^b")))
+
+;;; regexp-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
new file mode 100644
index 00000000000..5d936828fbb
--- /dev/null
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -0,0 +1,341 @@
+;;; seq-tests.el --- Tests for sequences.el
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <nicolas@petton.fr>
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for sequences.el
+
+;;; Code:
+
+(require 'ert)
+(require 'seq)
+
+(defmacro with-test-sequences (spec &rest body)
+  "Successively bind VAR to a list, vector, and string built from SEQ.
+Evaluate BODY for each created sequence.
+
+\(fn (var seq) body)"
+  (declare (indent 1) (debug ((symbolp form) body)))
+  (let ((initial-seq (make-symbol "initial-seq")))
+    `(let ((,initial-seq ,(cadr spec)))
+       ,@(mapcar (lambda (s)
+                   `(let ((,(car spec) (apply (function ,s) ,initial-seq)))
+                      ,@body))
+                 '(list vector string)))))
+
+(defun same-contents-p (seq1 seq2)
+  "Return t if SEQ1 and SEQ2 have the same contents, nil otherwise."
+  (equal (append seq1 '()) (append seq2 '())))
+
+(defun test-sequences-evenp (integer)
+  "Return t if INTEGER is even."
+  (eq (logand integer 1) 0))
+
+(defun test-sequences-oddp (integer)
+  "Return t if INTEGER is odd."
+  (not (test-sequences-evenp integer)))
+
+(ert-deftest test-setf-seq-elt ()
+  (with-test-sequences (seq '(1 2 3))
+    (setf (seq-elt seq 1) 4)
+    (should (= 4 (seq-elt seq 1)))))
+
+(ert-deftest test-seq-drop ()
+  (with-test-sequences (seq '(1 2 3 4))
+    (should (equal (seq-drop seq 0) seq))
+    (should (equal (seq-drop seq 1) (seq-subseq seq 1)))
+    (should (equal (seq-drop seq 2) (seq-subseq seq 2)))
+    (should (seq-empty-p (seq-drop seq 4)))
+    (should (seq-empty-p (seq-drop seq 10))))
+  (with-test-sequences (seq '())
+    (should (seq-empty-p (seq-drop seq 0)))
+    (should (seq-empty-p (seq-drop seq 1)))))
+
+(ert-deftest test-seq-take ()
+  (with-test-sequences (seq '(2 3 4 5))
+    (should (seq-empty-p (seq-take seq 0)))
+    (should (= (seq-length (seq-take seq 1)) 1))
+    (should (= (seq-elt (seq-take seq 1) 0) 2))
+    (should (same-contents-p (seq-take seq 3) '(2 3 4)))
+    (should (equal (seq-take seq 10) seq))))
+
+(ert-deftest test-seq-drop-while ()
+  (with-test-sequences (seq '(1 3 2 4))
+    (should (equal (seq-drop-while #'test-sequences-oddp seq)
+                   (seq-drop seq 2)))
+    (should (equal (seq-drop-while #'test-sequences-evenp seq)
+                   seq))
+    (should (seq-empty-p (seq-drop-while #'numberp seq))))
+  (with-test-sequences (seq '())
+    (should (seq-empty-p (seq-drop-while #'test-sequences-oddp seq)))))
+
+(ert-deftest test-seq-take-while ()
+  (with-test-sequences (seq '(1 3 2 4))
+    (should (equal (seq-take-while #'test-sequences-oddp seq)
+                   (seq-take seq 2)))
+    (should (seq-empty-p (seq-take-while #'test-sequences-evenp seq)))
+    (should (equal (seq-take-while #'numberp seq) seq)))
+  (with-test-sequences (seq '())
+    (should (seq-empty-p (seq-take-while #'test-sequences-oddp seq)))))
+
+(ert-deftest test-seq-filter ()
+  (with-test-sequences (seq '(6 7 8 9 10))
+    (should (equal (seq-filter #'test-sequences-evenp seq) '(6 8 10)))
+    (should (equal (seq-filter #'test-sequences-oddp seq) '(7 9)))
+    (should (equal (seq-filter (lambda (elt) nil) seq) '())))
+  (with-test-sequences (seq '())
+    (should (equal (seq-filter #'test-sequences-evenp seq) '()))))
+
+(ert-deftest test-seq-remove ()
+  (with-test-sequences (seq '(6 7 8 9 10))
+    (should (equal (seq-remove #'test-sequences-evenp seq) '(7 9)))
+    (should (equal (seq-remove #'test-sequences-oddp seq) '(6 8 10)))
+    (should (same-contents-p (seq-remove (lambda (elt) nil) seq) seq)))
+  (with-test-sequences (seq '())
+    (should (equal (seq-remove #'test-sequences-evenp seq) '()))))
+
+(ert-deftest test-seq-count ()
+  (with-test-sequences (seq '(6 7 8 9 10))
+    (should (equal (seq-count #'test-sequences-evenp seq) 3))
+    (should (equal (seq-count #'test-sequences-oddp seq) 2))
+    (should (equal (seq-count (lambda (elt) nil) seq) 0)))
+  (with-test-sequences (seq '())
+    (should (equal (seq-count #'test-sequences-evenp seq) 0))))
+
+(ert-deftest test-seq-reduce ()
+  (with-test-sequences (seq '(1 2 3 4))
+    (should (= (seq-reduce #'+ seq 0) 10))
+    (should (= (seq-reduce #'+ seq 5) 15)))
+  (with-test-sequences (seq '())
+    (should (eq (seq-reduce #'+ seq 0) 0))
+    (should (eq (seq-reduce #'+ seq 7) 7))))
+
+(ert-deftest test-seq-some ()
+  (with-test-sequences (seq '(4 3 2 1))
+    (should (seq-some #'test-sequences-evenp seq))
+    (should (seq-some #'test-sequences-oddp seq))
+    (should-not (seq-some (lambda (elt) (> elt 10)) seq)))
+  (with-test-sequences (seq '())
+    (should-not (seq-some #'test-sequences-oddp seq)))
+  (should (seq-some #'null '(1 nil 2))))
+
+(ert-deftest test-seq-find ()
+  (with-test-sequences (seq '(4 3 2 1))
+    (should (= 4 (seq-find #'test-sequences-evenp seq)))
+    (should (= 3 (seq-find #'test-sequences-oddp seq)))
+    (should-not (seq-find (lambda (elt) (> elt 10)) seq)))
+  (should-not (seq-find #'null '(1 nil 2)))
+  (should-not (seq-find #'null '(1 nil 2) t))
+  (should-not (seq-find #'null '(1 2 3)))
+  (should (seq-find #'null '(1 2 3) 'sentinel)))
+
+(ert-deftest test-seq-contains ()
+  (with-test-sequences (seq '(3 4 5 6))
+    (should (seq-contains seq 3))
+    (should-not (seq-contains seq 7)))
+  (with-test-sequences (seq '())
+    (should-not (seq-contains seq 3))
+    (should-not (seq-contains seq nil))))
+
+(ert-deftest test-seq-every-p ()
+  (with-test-sequences (seq '(43 54 22 1))
+    (should (seq-every-p (lambda (elt) t) seq))
+    (should-not (seq-every-p #'test-sequences-oddp seq))
+    (should-not (seq-every-p #'test-sequences-evenp seq)))
+  (with-test-sequences (seq '(42 54 22 2))
+    (should (seq-every-p #'test-sequences-evenp seq))
+    (should-not (seq-every-p #'test-sequences-oddp seq)))
+  (with-test-sequences (seq '())
+    (should (seq-every-p #'identity seq))
+    (should (seq-every-p #'test-sequences-evenp seq))))
+
+(ert-deftest test-seq-empty-p ()
+  (with-test-sequences (seq '(0))
+    (should-not (seq-empty-p seq)))
+  (with-test-sequences (seq '(0 1 2))
+    (should-not (seq-empty-p seq)))
+  (with-test-sequences (seq '())
+    (should (seq-empty-p seq))))
+
+(ert-deftest test-seq-sort ()
+  (should (equal (seq-sort #'< "cbaf") "abcf"))
+  (should (equal (seq-sort #'< '(2 1 9 4)) '(1 2 4 9)))
+  (should (equal (seq-sort #'< [2 1 9 4]) [1 2 4 9]))
+  (should (equal (seq-sort #'< "") "")))
+
+(ert-deftest test-seq-uniq ()
+  (with-test-sequences (seq '(2 4 6 8 6 4 3))
+    (should (equal (seq-uniq seq) '(2 4 6 8 3))))
+  (with-test-sequences (seq '(3 3 3 3 3))
+    (should (equal (seq-uniq seq) '(3))))
+  (with-test-sequences (seq '())
+    (should (equal (seq-uniq seq) '()))))
+
+(ert-deftest test-seq-subseq ()
+  (with-test-sequences (seq '(2 3 4 5))
+    (should (equal (seq-subseq seq 0 4) seq))
+    (should (same-contents-p (seq-subseq seq 2 4) '(4 5)))
+    (should (same-contents-p (seq-subseq seq 1 3) '(3 4)))
+    (should (same-contents-p (seq-subseq seq 1 -1) '(3 4))))
+  (should (vectorp (seq-subseq [2 3 4 5] 2)))
+  (should (stringp (seq-subseq "foo" 2 3)))
+  (should (listp (seq-subseq '(2 3 4 4) 2 3)))
+  (should-error (seq-subseq '(1 2 3) 4))
+  (should-not   (seq-subseq '(1 2 3) 3))
+  (should       (seq-subseq '(1 2 3) -3))
+  (should-error (seq-subseq '(1 2 3) 1 4))
+  (should       (seq-subseq '(1 2 3) 1 3))
+  (should-error (seq-subseq '() -1))
+  (should-error (seq-subseq [] -1))
+  (should-error (seq-subseq "" -1))
+  (should-not (seq-subseq '() 0))
+  (should-error (seq-subseq '() 0 -1)))
+
+(ert-deftest test-seq-concatenate ()
+  (with-test-sequences (seq '(2 4 6))
+    (should (equal (seq-concatenate 'string seq [8]) (string 2 4 6 8)))
+    (should (equal (seq-concatenate 'list seq '(8 10)) '(2 4 6 8 10)))
+    (should (equal (seq-concatenate 'vector seq '(8 10)) [2 4 6 8 10]))
+    (should (equal (seq-concatenate 'vector nil '(8 10)) [8 10]))
+    (should (equal (seq-concatenate 'vector seq nil) [2 4 6]))))
+
+(ert-deftest test-seq-mapcat ()
+  (should (equal (seq-mapcat #'seq-reverse '((3 2 1) (6 5 4)))
+                 '(1 2 3 4 5 6)))
+  (should (equal (seq-mapcat #'seq-reverse '[(3 2 1) (6 5 4)])
+                 '(1 2 3 4 5 6)))
+  (should (equal (seq-mapcat #'seq-reverse '((3 2 1) (6 5 4)) 'vector)
+                 '[1 2 3 4 5 6])))
+
+(ert-deftest test-seq-partition ()
+  (should (same-contents-p (seq-partition '(0 1 2 3 4 5 6 7) 3)
+                           '((0 1 2) (3 4 5) (6 7))))
+  (should (same-contents-p (seq-partition '[0 1 2 3 4 5 6 7] 3)
+                           '([0 1 2] [3 4 5] [6 7])))
+  (should (same-contents-p (seq-partition "Hello world" 2)
+                           '("He" "ll" "o " "wo" "rl" "d")))
+  (should (equal (seq-partition '() 2) '()))
+  (should (equal (seq-partition '(1 2 3) -1) '())))
+
+(ert-deftest test-seq-group-by ()
+  (with-test-sequences (seq '(1 2 3 4))
+   (should (equal (seq-group-by #'test-sequences-oddp seq)
+                  '((t 1 3) (nil 2 4)))))
+  (should (equal (seq-group-by #'car '((a 1) (b 3) (c 4) (a 2)))
+                 '((b (b 3)) (c (c 4)) (a (a 1) (a 2))))))
+
+(ert-deftest test-seq-reverse ()
+  (with-test-sequences (seq '(1 2 3 4))
+    (should (same-contents-p (seq-reverse seq) '(4 3 2 1)))
+    (should (equal (type-of (seq-reverse seq))
+                   (type-of seq)))))
+
+(ert-deftest test-seq-into ()
+  (let* ((vector [1 2 3])
+         (list (seq-into vector 'list)))
+    (should (same-contents-p vector list))
+    (should (listp list)))
+  (let* ((list '(hello world))
+         (vector (seq-into list 'vector)))
+    (should (same-contents-p vector list))
+    (should (vectorp vector)))
+  (let* ((string "hello")
+         (list (seq-into string 'list)))
+    (should (same-contents-p string list))
+    (should (stringp string)))
+  (let* ((string "hello")
+         (vector (seq-into string 'vector)))
+    (should (same-contents-p string vector))
+    (should (stringp string)))
+  (let* ((list nil)
+         (vector (seq-into list 'vector)))
+    (should (same-contents-p list vector))
+    (should (vectorp vector))))
+
+(ert-deftest test-seq-intersection ()
+  (let ((v1 [2 3 4 5])
+        (v2 [1 3 5 6 7]))
+    (should (same-contents-p (seq-intersection v1 v2)
+                             '(3 5))))
+  (let ((l1 '(2 3 4 5))
+        (l2 '(1 3 5 6 7)))
+    (should (same-contents-p (seq-intersection l1 l2)
+                             '(3 5))))
+  (let ((v1 [2 4 6])
+        (v2 [1 3 5]))
+    (should (seq-empty-p (seq-intersection v1 v2)))))
+
+(ert-deftest test-seq-difference ()
+  (let ((v1 [2 3 4 5])
+        (v2 [1 3 5 6 7]))
+    (should (same-contents-p (seq-difference v1 v2)
+                             '(2 4))))
+  (let ((l1 '(2 3 4 5))
+        (l2 '(1 3 5 6 7)))
+    (should (same-contents-p (seq-difference l1 l2)
+                             '(2 4))))
+  (let ((v1 [2 4 6])
+        (v2 [2 4 6]))
+    (should (seq-empty-p (seq-difference v1 v2)))))
+
+(ert-deftest test-seq-let ()
+  (with-test-sequences (seq '(1 2 3 4))
+    (seq-let (a b c d e) seq
+      (should (= a 1))
+      (should (= b 2))
+      (should (= c 3))
+      (should (= d 4))
+      (should (null e)))
+    (seq-let (a b &rest others) seq
+      (should (= a 1))
+      (should (= b 2))
+      (should (same-contents-p others (seq-drop seq 2)))))
+  (let ((seq '(1 (2 (3 (4))))))
+    (seq-let (_ (_ (_ (a)))) seq
+      (should (= a 4))))
+  (let (seq)
+    (seq-let (a b c) seq
+      (should (null a))
+      (should (null b))
+      (should (null c)))))
+
+(ert-deftest test-seq-min-max ()
+  (with-test-sequences (seq '(4 5 3 2 0 4))
+    (should (= (seq-min seq) 0))
+    (should (= (seq-max seq) 5))))
+
+(ert-deftest test-seq-into-sequence ()
+  (with-test-sequences (seq '(1 2 3))
+    (should (eq seq (seq-into-sequence seq)))
+    (should-error (seq-into-sequence 2))))
+
+(ert-deftest test-seq-position ()
+  (with-test-sequences (seq '(2 4 6))
+    (should (null (seq-position seq 1)))
+    (should (= (seq-position seq 4) 1)))
+  (let ((seq '(a b c)))
+    (should (null (seq-position seq 'd #'eq)))
+    (should (= (seq-position seq 'a #'eq) 0))
+    (should (null (seq-position seq (make-symbol "a") #'eq)))))
+
+(provide 'seq-tests)
+;;; seq-tests.el ends here
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
new file mode 100644
index 00000000000..bdd3dffe02a
--- /dev/null
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -0,0 +1,526 @@
+;;; subr-x-tests.el --- Testing the extended lisp routines
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Fabián E. Gallina <fgallina@gnu.org>
+;; Keywords:
+
+;; 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:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'subr-x)
+
+
+;; if-let tests
+
+(ert-deftest subr-x-test-if-let-single-binding-expansion ()
+  "Test single bindings are expanded properly."
+  (should (equal
+           (macroexpand
+            '(if-let (a 1)
+                 (- a)
+               "no"))
+           '(let* ((a (and t 1)))
+              (if a
+                  (- a)
+                "no"))))
+  (should (equal
+           (macroexpand
+            '(if-let (a)
+                 (- a)
+               "no"))
+           '(let* ((a (and t nil)))
+              (if a
+                  (- a)
+                "no")))))
+
+(ert-deftest subr-x-test-if-let-single-symbol-expansion ()
+  "Test single symbol bindings are expanded properly."
+  (should (equal
+           (macroexpand
+            '(if-let (a)
+                 (- a)
+               "no"))
+           '(let* ((a (and t nil)))
+              (if a
+                  (- a)
+                "no"))))
+  (should (equal
+           (macroexpand
+            '(if-let (a b c)
+                 (- a)
+               "no"))
+           '(let* ((a (and t nil))
+                   (b (and a nil))
+                   (c (and b nil)))
+              (if c
+                  (- a)
+                "no"))))
+  (should (equal
+           (macroexpand
+            '(if-let (a (b 2) c)
+                 (- a)
+               "no"))
+           '(let* ((a (and t nil))
+                   (b (and a 2))
+                   (c (and b nil)))
+              (if c
+                  (- a)
+                "no")))))
+
+(ert-deftest subr-x-test-if-let-nil-related-expansion ()
+  "Test nil is processed properly."
+  (should (equal
+           (macroexpand
+            '(if-let (nil)
+                 (- a)
+               "no"))
+           '(let* ((nil (and t nil)))
+              (if nil
+                  (- a)
+                "no"))))
+  (should (equal
+           (macroexpand
+            '(if-let ((nil))
+                 (- a)
+               "no"))
+           '(let* ((nil (and t nil)))
+              (if nil
+                  (- a)
+                "no"))))
+  (should (equal
+           (macroexpand
+            '(if-let ((a 1) (nil) (b 2))
+                 (- a)
+               "no"))
+           '(let* ((a (and t 1))
+                   (nil (and a nil))
+                   (b (and nil 2)))
+              (if b
+                  (- a)
+                "no"))))
+  (should (equal
+           (macroexpand
+            '(if-let ((a 1) nil (b 2))
+                 (- a)
+               "no"))
+           '(let* ((a (and t 1))
+                   (nil (and a nil))
+                   (b (and nil 2)))
+              (if b
+                  (- a)
+                "no")))))
+
+(ert-deftest subr-x-test-if-let-malformed-binding ()
+  "Test malformed bindings trigger errors."
+  (should-error (macroexpand
+                 '(if-let (_ (a 1 1) (b 2) (c 3) d)
+                      (- a)
+                    "no"))
+                :type 'error)
+  (should-error (macroexpand
+                 '(if-let (_ (a 1) (b 2 2) (c 3) d)
+                      (- a)
+                    "no"))
+                :type 'error)
+  (should-error (macroexpand
+                 '(if-let (_ (a 1) (b 2) (c 3 3) d)
+                      (- a)
+                    "no"))
+                :type 'error)
+  (should-error (macroexpand
+                 '(if-let ((a 1 1))
+                      (- a)
+                    "no"))
+                :type 'error))
+
+(ert-deftest subr-x-test-if-let-true ()
+  "Test `if-let' with truthy bindings."
+  (should (equal
+           (if-let (a 1)
+               a
+             "no")
+           1))
+  (should (equal
+           (if-let ((a 1) (b 2) (c 3))
+               (list a b c)
+             "no")
+           (list 1 2 3))))
+
+(ert-deftest subr-x-test-if-let-false ()
+  "Test `if-let' with falsie bindings."
+  (should (equal
+           (if-let (a nil)
+               (list a b c)
+             "no")
+           "no"))
+  (should (equal
+           (if-let ((a nil) (b 2) (c 3))
+               (list a b c)
+             "no")
+           "no"))
+  (should (equal
+           (if-let ((a 1) (b nil) (c 3))
+               (list a b c)
+             "no")
+           "no"))
+  (should (equal
+           (if-let ((a 1) (b 2) (c nil))
+               (list a b c)
+             "no")
+           "no"))
+  (should (equal
+           (if-let (z (a 1) (b 2) (c 3))
+               (list a b c)
+             "no")
+           "no"))
+  (should (equal
+           (if-let ((a 1) (b 2) (c 3) d)
+               (list a b c)
+             "no")
+           "no")))
+
+(ert-deftest subr-x-test-if-let-bound-references ()
+  "Test `if-let' bindings can refer to already bound symbols."
+  (should (equal
+           (if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
+               (list a b c)
+             "no")
+           (list 1 2 3))))
+
+(ert-deftest subr-x-test-if-let-and-laziness-is-preserved ()
+  "Test `if-let' respects `and' laziness."
+  (let (a-called b-called c-called)
+    (should (equal
+             (if-let ((a nil)
+                      (b (setq b-called t))
+                      (c (setq c-called t)))
+                 "yes"
+               (list a-called b-called c-called))
+             (list nil nil nil))))
+  (let (a-called b-called c-called)
+    (should (equal
+             (if-let ((a (setq a-called t))
+                      (b nil)
+                      (c (setq c-called t)))
+                 "yes"
+               (list a-called b-called c-called))
+             (list t nil nil))))
+  (let (a-called b-called c-called)
+    (should (equal
+             (if-let ((a (setq a-called t))
+                      (b (setq b-called t))
+                      (c nil)
+                      (d (setq c-called t)))
+                 "yes"
+               (list a-called b-called c-called))
+             (list t t nil)))))
+
+
+;; when-let tests
+
+(ert-deftest subr-x-test-when-let-body-expansion ()
+  "Test body allows for multiple sexps wrapping with progn."
+  (should (equal
+           (macroexpand
+            '(when-let (a 1)
+               (message "opposite")
+               (- a)))
+           '(let* ((a (and t 1)))
+              (if a
+                  (progn
+                    (message "opposite")
+                    (- a)))))))
+
+(ert-deftest subr-x-test-when-let-single-binding-expansion ()
+  "Test single bindings are expanded properly."
+  (should (equal
+           (macroexpand
+            '(when-let (a 1)
+               (- a)))
+           '(let* ((a (and t 1)))
+              (if a
+                  (- a)))))
+  (should (equal
+           (macroexpand
+            '(when-let (a)
+               (- a)))
+           '(let* ((a (and t nil)))
+              (if a
+                  (- a))))))
+
+(ert-deftest subr-x-test-when-let-single-symbol-expansion ()
+  "Test single symbol bindings are expanded properly."
+  (should (equal
+           (macroexpand
+            '(when-let (a)
+               (- a)))
+           '(let* ((a (and t nil)))
+              (if a
+                  (- a)))))
+  (should (equal
+           (macroexpand
+            '(when-let (a b c)
+               (- a)))
+           '(let* ((a (and t nil))
+                   (b (and a nil))
+                   (c (and b nil)))
+              (if c
+                  (- a)))))
+  (should (equal
+           (macroexpand
+            '(when-let (a (b 2) c)
+               (- a)))
+           '(let* ((a (and t nil))
+                   (b (and a 2))
+                   (c (and b nil)))
+              (if c
+                  (- a))))))
+
+(ert-deftest subr-x-test-when-let-nil-related-expansion ()
+  "Test nil is processed properly."
+  (should (equal
+           (macroexpand
+            '(when-let (nil)
+               (- a)))
+           '(let* ((nil (and t nil)))
+              (if nil
+                  (- a)))))
+  (should (equal
+           (macroexpand
+            '(when-let ((nil))
+               (- a)))
+           '(let* ((nil (and t nil)))
+              (if nil
+                  (- a)))))
+  (should (equal
+           (macroexpand
+            '(when-let ((a 1) (nil) (b 2))
+               (- a)))
+           '(let* ((a (and t 1))
+                   (nil (and a nil))
+                   (b (and nil 2)))
+              (if b
+                  (- a)))))
+  (should (equal
+           (macroexpand
+            '(when-let ((a 1) nil (b 2))
+               (- a)))
+           '(let* ((a (and t 1))
+                   (nil (and a nil))
+                   (b (and nil 2)))
+              (if b
+                  (- a))))))
+
+(ert-deftest subr-x-test-when-let-malformed-binding ()
+  "Test malformed bindings trigger errors."
+  (should-error (macroexpand
+                 '(when-let (_ (a 1 1) (b 2) (c 3) d)
+                    (- a)))
+                :type 'error)
+  (should-error (macroexpand
+                 '(when-let (_ (a 1) (b 2 2) (c 3) d)
+                    (- a)))
+                :type 'error)
+  (should-error (macroexpand
+                 '(when-let (_ (a 1) (b 2) (c 3 3) d)
+                    (- a)))
+                :type 'error)
+  (should-error (macroexpand
+                 '(when-let ((a 1 1))
+                    (- a)))
+                :type 'error))
+
+(ert-deftest subr-x-test-when-let-true ()
+  "Test `when-let' with truthy bindings."
+  (should (equal
+           (when-let (a 1)
+             a)
+           1))
+  (should (equal
+           (when-let ((a 1) (b 2) (c 3))
+             (list a b c))
+           (list 1 2 3))))
+
+(ert-deftest subr-x-test-when-let-false ()
+  "Test `when-let' with falsie bindings."
+  (should (equal
+           (when-let (a nil)
+             (list a b c)
+             "no")
+           nil))
+  (should (equal
+           (when-let ((a nil) (b 2) (c 3))
+             (list a b c)
+             "no")
+           nil))
+  (should (equal
+           (when-let ((a 1) (b nil) (c 3))
+             (list a b c)
+             "no")
+           nil))
+  (should (equal
+           (when-let ((a 1) (b 2) (c nil))
+             (list a b c)
+             "no")
+           nil))
+  (should (equal
+           (when-let (z (a 1) (b 2) (c 3))
+             (list a b c)
+             "no")
+           nil))
+  (should (equal
+           (when-let ((a 1) (b 2) (c 3) d)
+             (list a b c)
+             "no")
+           nil)))
+
+(ert-deftest subr-x-test-when-let-bound-references ()
+  "Test `when-let' bindings can refer to already bound symbols."
+  (should (equal
+           (when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
+             (list a b c))
+           (list 1 2 3))))
+
+(ert-deftest subr-x-test-when-let-and-laziness-is-preserved ()
+  "Test `when-let' respects `and' laziness."
+  (let (a-called b-called c-called)
+    (should (equal
+             (progn
+               (when-let ((a nil)
+                          (b (setq b-called t))
+                          (c (setq c-called t)))
+                 "yes")
+               (list a-called b-called c-called))
+             (list nil nil nil))))
+  (let (a-called b-called c-called)
+    (should (equal
+             (progn
+               (when-let ((a (setq a-called t))
+                          (b nil)
+                          (c (setq c-called t)))
+                 "yes")
+               (list a-called b-called c-called))
+             (list t nil nil))))
+  (let (a-called b-called c-called)
+    (should (equal
+             (progn
+               (when-let ((a (setq a-called t))
+                          (b (setq b-called t))
+                          (c nil)
+                          (d (setq c-called t)))
+                 "yes")
+               (list a-called b-called c-called))
+             (list t t nil)))))
+
+
+;; Thread first tests
+
+(ert-deftest subr-x-test-thread-first-no-forms ()
+  "Test `thread-first' with no forms expands to the first form."
+  (should (equal (macroexpand '(thread-first 5)) 5))
+  (should (equal (macroexpand '(thread-first (+ 1 2))) '(+ 1 2))))
+
+(ert-deftest subr-x-test-thread-first-function-names-are-threaded ()
+  "Test `thread-first' wraps single function names."
+  (should (equal (macroexpand
+                  '(thread-first 5
+                     -))
+                 '(- 5)))
+  (should (equal (macroexpand
+                  '(thread-first (+ 1 2)
+                     -))
+                 '(- (+ 1 2)))))
+
+(ert-deftest subr-x-test-thread-first-expansion ()
+  "Test `thread-first' expands correctly."
+  (should (equal
+           (macroexpand '(thread-first
+                             5
+                           (+ 20)
+                           (/ 25)
+                           -
+                           (+ 40)))
+           '(+ (- (/ (+ 5 20) 25)) 40))))
+
+(ert-deftest subr-x-test-thread-first-examples ()
+  "Test several `thread-first' examples."
+  (should (equal (thread-first (+ 40 2)) 42))
+  (should (equal (thread-first
+                     5
+                   (+ 20)
+                   (/ 25)
+                   -
+                   (+ 40)) 39))
+  (should (equal (thread-first
+                     "this-is-a-string"
+                   (split-string "-")
+                   (nbutlast 2)
+                   (append (list "good")))
+                 (list "this" "is" "good"))))
+
+;; Thread last tests
+
+(ert-deftest subr-x-test-thread-last-no-forms ()
+  "Test `thread-last' with no forms expands to the first form."
+  (should (equal (macroexpand '(thread-last 5)) 5))
+  (should (equal (macroexpand '(thread-last (+ 1 2))) '(+ 1 2))))
+
+(ert-deftest subr-x-test-thread-last-function-names-are-threaded ()
+  "Test `thread-last' wraps single function names."
+  (should (equal (macroexpand
+                  '(thread-last 5
+                     -))
+                 '(- 5)))
+  (should (equal (macroexpand
+                  '(thread-last (+ 1 2)
+                     -))
+                 '(- (+ 1 2)))))
+
+(ert-deftest subr-x-test-thread-last-expansion ()
+  "Test `thread-last' expands correctly."
+  (should (equal
+           (macroexpand '(thread-last
+                             5
+                           (+ 20)
+                           (/ 25)
+                           -
+                           (+ 40)))
+           '(+ 40 (- (/ 25 (+ 20 5)))))))
+
+(ert-deftest subr-x-test-thread-last-examples ()
+  "Test several `thread-last' examples."
+  (should (equal (thread-last (+ 40 2)) 42))
+  (should (equal (thread-last
+                     5
+                   (+ 20)
+                   (/ 25)
+                   -
+                   (+ 40)) 39))
+  (should (equal (thread-last
+                     (list 1 -2 3 -4 5)
+                   (mapcar #'abs)
+                   (cl-reduce #'+)
+                   (format "abs sum is: %s"))
+                 "abs sum is: 15")))
+
+
+(provide 'subr-x-tests)
+;;; subr-x-tests.el ends here
diff --git a/test/lisp/emacs-lisp/tabulated-list-test.el b/test/lisp/emacs-lisp/tabulated-list-test.el
new file mode 100644
index 00000000000..9aa62ee59e5
--- /dev/null
+++ b/test/lisp/emacs-lisp/tabulated-list-test.el
@@ -0,0 +1,118 @@
+;;; tabulated-list-test.el --- Tests for emacs-lisp/tabulated-list.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'tabulated-list)
+(require 'ert)
+
+(defconst tabulated-list--test-entries
+  '(("zzzz-game" ["zzzz-game" "zzzz-game" "2113" "installed" " play zzzz in Emacs"])
+    ("4clojure"  ["4clojure" "4clojure" "1507" "obsolete" " Open and evaluate 4clojure.com questions"])
+    ("abc-mode"  ["abc-mode" "abc-mode" "944" "available" " Major mode for editing abc music files"])
+    ("mode"      ["mode" "mode" "1128" "installed" " A simple mode for editing Actionscript 3 files"])))
+
+(defun tabulated-list--test-sort-car (a b)
+  (string< (car a) (car b)))
+
+(defconst tabulated-list--test-format
+  [("name" 10 tabulated-list--test-sort-car)
+   ("name-2" 10 t)
+   ("Version" 9 nil)
+   ("Status" 10 )
+   ("Description" 0 nil)])
+
+(defmacro tabulated-list--test-with-buffer (&rest body)
+  `(with-temp-buffer
+     (tabulated-list-mode)
+     (setq tabulated-list-entries (copy-alist tabulated-list--test-entries))
+     (setq tabulated-list-format tabulated-list--test-format)
+     (setq tabulated-list-padding 7)
+     (tabulated-list-init-header)
+     (tabulated-list-print)
+     ,@body))
+
+
+;;; Tests
+(ert-deftest tabulated-list-print ()
+  (tabulated-list--test-with-buffer
+   ;; Basic printing.
+   (should (string= (buffer-substring-no-properties (point-min) (point-max))
+                    "       zzzz-game  zzzz-game  2113      installed   play zzzz in Emacs
+       4clojure   4clojure   1507      obsolete    Open and evaluate 4clojure.com questions
+       abc-mode   abc-mode   944       available   Major mode for editing abc music files
+       mode       mode       1128      installed   A simple mode for editing Actionscript 3 files\n"))
+   ;; Preserve position.
+   (forward-line 3)
+   (let ((pos (thing-at-point 'line)))
+     (pop tabulated-list-entries)
+     (tabulated-list-print t)
+     (should (equal (thing-at-point 'line) pos))
+     (should (string= (buffer-substring-no-properties (point-min) (point-max))
+                      "       4clojure   4clojure   1507      obsolete    Open and evaluate 4clojure.com questions
+       abc-mode   abc-mode   944       available   Major mode for editing abc music files
+       mode       mode       1128      installed   A simple mode for editing Actionscript 3 files\n"))
+     ;; Check the UPDATE argument
+     (pop tabulated-list-entries)
+     (setf (cdr (car tabulated-list-entries)) (list ["x" "x" "944" "available" " XX"]))
+     (tabulated-list-print t t)
+     (should (string= (buffer-substring-no-properties (point-min) (point-max))
+                      "       x          x          944       available   XX
+       mode       mode       1128      installed   A simple mode for editing Actionscript 3 files\n"))
+     (should (equal (thing-at-point 'line) pos)))))
+
+(ert-deftest tabulated-list-sort ()
+  (tabulated-list--test-with-buffer
+   ;; Basic sorting
+   (goto-char (point-min))
+   (skip-chars-forward "[:blank:]")
+   (tabulated-list-sort)
+   (let ((text (buffer-substring-no-properties (point-min) (point-max))))
+     (should (string= text "       4clojure   4clojure   1507      obsolete    Open and evaluate 4clojure.com questions
+       abc-mode   abc-mode   944       available   Major mode for editing abc music files
+       mode       mode       1128      installed   A simple mode for editing Actionscript 3 files
+       zzzz-game  zzzz-game  2113      installed   play zzzz in Emacs\n"))
+
+     (skip-chars-forward "^[:blank:]")
+     (skip-chars-forward "[:blank:]")
+     (should (equal (get-text-property (point) 'tabulated-list-column-name)
+                    "name-2"))
+     (tabulated-list-sort)
+     ;; Check a `t' as the sorting predicate.
+     (should (string= text (buffer-substring-no-properties (point-min) (point-max))))
+     ;; Invert.
+     (tabulated-list-sort 1)
+     (should (string= (buffer-substring-no-properties (point-min) (point-max))
+                      "       zzzz-game  zzzz-game  2113      installed   play zzzz in Emacs
+       mode       mode       1128      installed   A simple mode for editing Actionscript 3 files
+       abc-mode   abc-mode   944       available   Major mode for editing abc music files
+       4clojure   4clojure   1507      obsolete    Open and evaluate 4clojure.com questions\n"))
+     ;; Again
+     (tabulated-list-sort 1)
+     (should (string= text (buffer-substring-no-properties (point-min) (point-max)))))
+   ;; Check that you can't sort some cols.
+   (skip-chars-forward "^[:blank:]")
+   (skip-chars-forward "[:blank:]")
+   (should-error (tabulated-list-sort) :type 'user-error)
+   (should-error (tabulated-list-sort 4) :type 'user-error)))
+
+(provide 'tabulated-list-test)
+;;; tabulated-list-test.el ends here
diff --git a/test/lisp/emacs-lisp/thunk-tests.el b/test/lisp/emacs-lisp/thunk-tests.el
new file mode 100644
index 00000000000..7abbd299ead
--- /dev/null
+++ b/test/lisp/emacs-lisp/thunk-tests.el
@@ -0,0 +1,55 @@
+;;; thunk-tests.el --- Tests for thunk.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <nicolas@petton.fr>
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for thunk.el
+
+;;; Code:
+
+(require 'ert)
+(require 'thunk)
+
+(ert-deftest thunk-should-be-lazy ()
+  (let (x)
+    (thunk-delay (setq x t))
+    (should (null x))))
+
+(ert-deftest thunk-can-be-evaluated ()
+  (let* (x
+         (thunk (thunk-delay (setq x t))))
+    (should-not (thunk-evaluated-p thunk))
+    (should (null x))
+    (thunk-force thunk)
+    (should (thunk-evaluated-p thunk))
+    (should x)))
+
+(ert-deftest thunk-evaluation-is-cached ()
+  (let* ((x 0)
+        (thunk (thunk-delay (setq x (1+ x)))))
+    (thunk-force thunk)
+    (should (= x 1))
+    (thunk-force thunk)
+    (should (= x 1))))
+
+(provide 'thunk-tests)
+;;; thunk-tests.el ends here
diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el
new file mode 100644
index 00000000000..b006b398a81
--- /dev/null
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -0,0 +1,42 @@
+;;; timer-tests.el --- tests for timers -*- lexical-binding:t -*-
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(ert-deftest timer-tests-sit-for ()
+  (let ((timer-ran nil)
+        ;; Want sit-for behavior when interactive
+        (noninteractive nil))
+    (run-at-time '(0 0 0 0)
+                 nil
+                 (lambda () (setq timer-ran t)))
+    ;; The test assumes run-at-time didn't take the liberty of firing
+    ;; the timer, so assert the test's assumption
+    (should (not timer-ran))
+    (sit-for 0 t)
+    (should timer-ran)))
+
+(ert-deftest timer-tests-debug-timer-check ()
+  ;; This function exists only if --enable-checking.
+  (if (fboundp 'debug-timer-check)
+      (should (debug-timer-check)) t))
+
+;;; timer-tests.el ends here
author	Phillip Lord <phillip.lord@russet.org.uk>	2015-11-23 22:02:42 +0000
committer	Phillip Lord <phillip.lord@russet.org.uk>	2015-11-24 17:04:22 +0000
commit	22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e (patch)
tree	779ff7e07667194416e01c6a6e8bd7b970244c70 /test/lisp/emacs-lisp
parent	c378d6c33f751d1a0b97958f3cacfe0b07c72f58 (diff)
download	emacs-22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e.tar.gz emacs-22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e.tar.bz2 emacs-22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e.zip