Merge branch 'master' into comment-cachecomment-cache

1 files changed, 186 insertions, 0 deletions

diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el
new file mode 100644
index 00000000000..d31379c3aa2
--- /dev/null
+++ b/test/lisp/emacs-lisp/testcover-tests.el
@@ -0,0 +1,186 @@
+;;; testcover-tests.el --- Testcover test suite   -*- lexical-binding:t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell
+
+;; 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:
+
+;; Testcover test suite.
+;; * All the test cases are in testcover-resources/testcover-cases.el.
+;;   See that file for an explanation of the test case format.
+;; * `testcover-tests-define-tests', which is run when this file is
+;;   loaded, reads testcover-resources/testcover-cases.el and defines
+;;   ERT tests for each test case.
+
+;;; Code:
+
+(require 'ert)
+(require 'testcover)
+(require 'skeleton)
+
+;; Use `eval-and-compile' around all these definitions because they're
+;; used by the macro `testcover-tests-define-tests'.
+
+(eval-and-compile
+  (defvar testcover-tests-file-dir
+    (expand-file-name
+     "testcover-resources/"
+     (file-name-directory (or (bound-and-true-p byte-compile-current-file)
+                              load-file-name
+                              buffer-file-name)))
+    "Directory of the \"testcover-tests.el\" file."))
+
+(eval-and-compile
+  (defvar testcover-tests-test-cases
+    (expand-file-name "testcases.el" testcover-tests-file-dir)
+    "File containing marked up code to instrument and check."))
+
+;; Convert Testcover's overlays to plain text.
+
+(eval-and-compile
+  (defun testcover-tests-markup-region (beg end &rest optargs)
+    "Mark up test code within region between BEG and END.
+Convert Testcover's tan and red splotches to %%% and !!! for
+testcases.el.  This can be used to create test cases if Testcover
+is working correctly on a code sample.  OPTARGS are optional
+arguments for `testcover-start'."
+    (interactive "r")
+    (let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))
+          (code (buffer-substring beg end))
+          (marked-up-code))
+      (unwind-protect
+          (progn
+            (with-temp-file tempfile
+              (insert code))
+            (save-current-buffer
+              (let ((buf (find-file-noselect tempfile)))
+                (set-buffer buf)
+                (apply 'testcover-start (cons tempfile optargs))
+                (testcover-mark-all buf)
+                (dolist (overlay (overlays-in (point-min) (point-max)))
+                  (let ((ov-face (overlay-get overlay 'face)))
+                    (goto-char (overlay-end overlay))
+                    (cond
+                     ((eq ov-face 'testcover-nohits) (insert "!!!"))
+                     ((eq ov-face 'testcover-1value) (insert "%%%"))
+                     (t nil))))
+                (setq marked-up-code (buffer-string)))
+              (set-buffer-modified-p nil)))
+        (ignore-errors (kill-buffer (find-file-noselect tempfile)))
+        (ignore-errors (delete-file tempfile)))
+
+      ;; Now replace the original code with the marked up code.
+      (delete-region beg end)
+      (insert marked-up-code))))
+
+(eval-and-compile
+  (defun testcover-tests-unmarkup-region (beg end)
+    "Remove the markup used in testcases.el between BEG and END."
+    (interactive "r")
+    (save-excursion
+      (save-restriction
+        (narrow-to-region beg end)
+        (goto-char (point-min))
+        (while (re-search-forward "!!!\\|%%%" nil t)
+          (replace-match ""))))))
+
+(define-skeleton testcover-tests-skeleton
+  "Write a testcase for testcover-tests.el."
+  "Enter name of test: "
+  ";; ==== "  str " ====\n"
+  "\"docstring\"\n"
+  ";; Directives for ERT should go here, if any.\n"
+  ";; ====\n"
+  ";; Replace this line with annotated test code.\n")
+
+;; Check a test case.
+
+(eval-and-compile
+  (defun testcover-tests-run-test-case (marked-up-code)
+    "Test the operation of Testcover on the string MARKED-UP-CODE."
+    (let ((tempfile (make-temp-file "testcover-tests-" nil ".el")))
+      (unwind-protect
+          (progn
+            (with-temp-file tempfile
+              (insert marked-up-code))
+            ;; Remove the marks and mark the code up again. The original
+            ;; and recreated versions should match.
+            (save-current-buffer
+              (set-buffer (find-file-noselect tempfile))
+              ;; Fail the test if the debugger tries to become active,
+              ;; which will happen if Testcover's reinstrumentation
+              ;; leaves an edebug-enter in the code. This will also
+              ;; prevent debugging these tests using Edebug.
+              (cl-letf (((symbol-function #'edebug-enter)
+                         (lambda (&rest _args)
+                           (ert-fail
+                            (concat "Debugger invoked during test run "
+                                    "(possible edebug-enter not replaced)")))))
+                (dolist (byte-compile '(t nil))
+                  (testcover-tests-unmarkup-region (point-min) (point-max))
+                  (unwind-protect
+                      (testcover-tests-markup-region (point-min) (point-max) byte-compile)
+                    (set-buffer-modified-p nil))
+                  (should (string= marked-up-code
+                                   (buffer-string)))))))
+        (ignore-errors (kill-buffer (find-file-noselect tempfile)))
+        (ignore-errors (delete-file tempfile))))))
+
+;; Convert test case file to ert-defmethod.
+
+(eval-and-compile
+  (defun testcover-tests-build-test-cases ()
+    "Parse the test case file and return a list of ERT test definitions.
+Construct and return a list of `ert-deftest' forms.  See testcases.el
+for documentation of the test definition format."
+    (let (results)
+      (with-temp-buffer
+        (insert-file-contents testcover-tests-test-cases)
+        (goto-char (point-min))
+        (while (re-search-forward
+                (concat "^;; ==== \\([^ ]+?\\) ====\n"
+                        "\\(\\(?:.*\n\\)*?\\)"
+                        ";; ====\n"
+                        "\\(\\(?:.*\n\\)*?\\)"
+                        "\\(\\'\\|;; ====\\)")
+                nil t)
+          (let ((name (match-string 1))
+                (splice (car (read-from-string
+                              (format "(%s)" (match-string 2)))))
+                (code (match-string 3)))
+            (push
+             `(ert-deftest ,(intern (concat "testcover-tests-" name)) ()
+                ,@splice
+                (testcover-tests-run-test-case ,code))
+             results))
+          (beginning-of-line)))
+      results)))
+
+;; Define all the tests.
+
+(defmacro testcover-tests-define-tests ()
+  "Construct and define ERT test methods using the test case file."
+  (let* ((test-cases (testcover-tests-build-test-cases)))
+    `(progn ,@test-cases)))
+
+(testcover-tests-define-tests)
+
+(provide 'testcover-tests)
+
+;;; testcover-tests.el ends here