From b58deef468e6d81c75acf73a7ddaf57514acc9ac Mon Sep 17 00:00:00 2001
From: gazally <gazally@users.noreply.github.com>
Date: Fri, 20 Jan 2017 13:58:41 -0800
Subject: [PATCH v3] Add tests for lisp/emacs-lisp/testcover.el

* test/lisp/emacs-lisp/testcover-tests.el: New file.
* test/lisp/emacs-lisp/testcover-resources/testcases.el: New file.
---
 .../emacs-lisp/testcover-resources/testcases.el    | 493 +++++++++++++++++++++
 test/lisp/emacs-lisp/testcover-tests.el            | 186 ++++++++
 2 files changed, 679 insertions(+)
 create mode 100644 test/lisp/emacs-lisp/testcover-resources/testcases.el
 create mode 100644 test/lisp/emacs-lisp/testcover-tests.el

diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el
new file mode 100644
index 0000000..1eb791a
--- /dev/null
+++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el
@@ -0,0 +1,493 @@
+;;;; testcases.el -- Test cases for testcover-tests.el
+
+;; 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:
+
+;; * This file should not be loaded directly.  It is meant to be read
+;;   by `testcover-tests-build-test-cases'.
+;;
+;; * Test cases begin with ;; ==== name ====.  The symbol name between
+;;   the ===='s is used to create the name of the test.
+;;
+;; * Following the beginning comment place the test docstring and
+;;   any tags or keywords for ERT.  These will be spliced into the
+;;   ert-deftest for the test.
+;;
+;; * To separate the above from the test case code, use another
+;;   comment: ;; ====
+;;
+;; * These special comments should start at the beginning of a line.
+;;
+;; * `testcover-tests-skeleton' will prompt you for a test name and
+;;   insert the special comments.
+;;
+;; * The test case code should be annotated with %%% at the end of
+;;   each form where a tan splotch is expected, and !!! at the end
+;;   of each form where a red mark is expected.
+;;
+;; * If Testcover is working correctly on your code sample, using
+;;   `testcover-tests-markup-region' and
+;;   `testcover-tests-unmarkup-region' can make creating test cases
+;;   easier.
+
+;;; Code:
+;;; Test Cases:
+
+;; ==== constants-bug-25316 ====
+"Testcover doesn't splotch constants."
+:expected-result :failed
+;; ====
+(defconst testcover-testcase-const "apples")
+(defun testcover-testcase-zero () 0)
+(defun testcover-testcase-list-consts ()
+  (list
+   emacs-version 10
+   "hello"
+   `(a b c ,testcover-testcase-const)
+   '(1 2 3)
+   testcover-testcase-const
+   (testcover-testcase-zero)
+   nil))
+
+(defun testcover-testcase-add-to-const-list (arg)
+  (cons arg%%% (testcover-testcase-list-consts))%%%)
+
+(should (equal (testcover-testcase-add-to-const-list 'a)
+               `(a ,emacs-version 10 "hello" (a b c "apples") (1 2 3)
+                   "apples" 0 nil)))
+
+;; ==== customize-defcustom-bug-25326 ====
+"Testcover doesn't prevent testing of defcustom values."
+:expected-result :failed
+;; ====
+(defgroup testcover-testcase nil
+  "Test case for testcover"
+  :group 'lisp
+  :prefix "testcover-testcase-"
+  :version "26.0")
+(defcustom testcover-testcase-flag t
+  "Test value used by testcover-tests.el"
+  :type 'boolean
+  :group 'testcover-testcase)
+(defun testcover-testcase-get-flag ()
+  testcover-testcase-flag)
+
+(testcover-testcase-get-flag)
+(setq testcover-testcase-flag (not testcover-testcase-flag))
+(testcover-testcase-get-flag)
+
+;; ==== no-returns ====
+"Testcover doesn't splotch functions which don't return."
+;; ====
+(defun testcover-testcase-play-ball (retval)
+  (catch 'ball
+    (throw 'ball retval%%%))%%%)  ; catch gets marked but not throw
+
+(defun testcover-testcase-not-my-favorite-error-message ()
+  (signal 'wrong-type-argument (list 'consp nil)))
+
+(should (testcover-testcase-play-ball t))
+(condition-case nil
+    (testcover-testcase-not-my-favorite-error-message)
+  (error nil))
+
+;; ==== noreturn-symbol ====
+"Wrapping a form with noreturn prevents splotching."
+;; ====
+(defun testcover-testcase-cancel (spacecraft)
+  (error "no destination for %s" spacecraft))
+(defun testcover-testcase-launch (spacecraft planet)
+  (if (null planet)
+      (noreturn (testcover-testcase-cancel spacecraft%%%))
+    (list spacecraft%%% planet%%%)%%%)%%%)
+(defun testcover-testcase-launch-2 (spacecraft planet)
+  (if (null planet%%%)%%%
+    (testcover-testcase-cancel spacecraft%%%)!!!
+    (list spacecraft!!! planet!!!)!!!)!!!)
+(should (equal (testcover-testcase-launch "Curiosity" "Mars") '("Curiosity" "Mars")))
+(condition-case err
+    (testcover-testcase-launch "Voyager" nil)
+  (error err))
+(condition-case err
+    (testcover-testcase-launch-2 "Voyager II" nil)
+  (error err))
+
+(should-error (testcover-testcase-launch "Voyager" nil))
+(should-error (testcover-testcase-launch-2 "Voyager II" nil))
+
+;; ==== 1-value-symbol-bug-25316 ====
+"Wrapping a form with 1value prevents splotching."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-always-zero (num)
+  (- num%%% num%%%)%%%)
+(defun testcover-testcase-still-always-zero (num)
+  (1value (- num%%% num%%% (- num%%% num%%%)%%%)))
+(defun testcover-testcase-never-called (num)
+  (1value (/ num!!! num!!!)!!!)!!!)
+(should (eql 0 (testcover-testcase-always-zero 3)))
+(should (eql 0 (testcover-testcase-still-always-zero 5)))
+
+;; ==== dotimes-dolist ====
+"Dolist and dotimes with a 1valued return value are 1valued."
+;; ====
+(defun testcover-testcase-do-over (things)
+  (dolist (thing things%%%)
+    (list thing))
+  (dolist (thing things%%% 42)
+    (list thing))
+  (dolist (thing things%%% things%%%)
+    (list thing))%%%)
+(defun testcover-testcase-do-more (count)
+  (dotimes (num count%%%)
+    (+ num num))
+  (dotimes (num count%%% count%%%)
+    (+ num num))%%%
+    (dotimes (num count%%% 0)
+      (+ num num)))
+(should (equal '(a b c) (testcover-testcase-do-over '(a b c))))
+(should (eql 0 (testcover-testcase-do-more 2)))
+
+;; ==== let-last-form ====
+"A let form is 1valued if its last form is 1valued."
+;; ====
+(defun testcover-testcase-double (num)
+  (let ((double (* num%%% 2)%%%))
+    double%%%)%%%)
+(defun testcover-testcase-nullbody-let (num)
+  (let* ((square (* num%%% num%%%)%%%)
+         (double (* 2 num%%%)%%%))))
+(defun testcover-testcase-answer ()
+  (let ((num 100))
+    42))
+(should-not (testcover-testcase-nullbody-let 3))
+(should (eql (testcover-testcase-answer) 42))
+(should (eql (testcover-testcase-double 10) 20))
+
+;; ==== if-with-1value-clauses ====
+"An if is 1valued if both then and else are 1valued."
+;; ====
+(defun testcover-testcase-describe (val)
+  (if (zerop val%%%)%%%
+    "a number"
+    "a different number"))
+(defun testcover-testcase-describe-2 (val)
+  (if (zerop val)
+      "zero"
+    "not zero"))
+(defun testcover-testcase-describe-3 (val)
+  (if (zerop val%%%)%%%
+    "zero"
+    (format "%d" val%%%)%%%)%%%)
+(should (equal (testcover-testcase-describe 0) "a number"))
+(should (equal (testcover-testcase-describe-2 0) "zero"))
+(should (equal (testcover-testcase-describe-2 1) "not zero"))
+(should (equal (testcover-testcase-describe-3 1) "1"))
+
+;; ==== cond-with-1value-clauses ====
+"A cond form is marked 1valued if all clauses are 1valued."
+;; ====
+(defun testcover-testcase-cond (num)
+  (cond
+   ((eql num%%% 0)%%% 'a)
+   ((eql num%%% 1)%%% 'b)
+   ((eql num!!! 2)!!! 'c)))
+(defun testcover-testcase-cond-2 (num)
+  (cond
+   ((eql num%%% 0)%%% (cons 'a 0)!!!)
+   ((eql num%%% 1)%%% 'b))%%%)
+(should (eql (testcover-testcase-cond 1) 'b))
+(should (eql (testcover-testcase-cond-2 1) 'b))
+
+;; ==== condition-case-with-1value-components ====
+"A condition-case is marked 1valued if its body and handlers are."
+;; ====
+(defun testcover-testcase-cc (arg)
+  (condition-case nil
+      (if (null arg%%%)%%%
+        (error "foo")
+        "0")!!!
+        (error nil)))
+(should-not (testcover-testcase-cc nil))
+
+;; ==== quotes-within-backquotes-bug-25316 ====
+"Forms to instrument are found within quotes within backquotes."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-make-list ()
+  (list 'defun 'defvar))
+(defmacro testcover-testcase-bq-macro (arg)
+  (declare (debug t))
+  `(memq ,arg%%% '(defconst ,@(testcover-testcase-make-list)))%%%)
+(defun testcover-testcase-use-bq-macro (arg)
+  (testcover-testcase-bq-macro arg%%%)%%%)
+(should (equal '(defun defvar) (testcover-testcase-use-bq-macro 'defun)))
+
+;; ==== progn-functions ====
+"Some forms are 1value if their last argument is 1value."
+;; ====
+(defun testcover-testcase-one (arg)
+  (progn
+    (setq arg (1- arg%%%)%%%)%%%)%%%
+    (progn
+      (setq arg (1+ arg%%%)%%%)%%%
+      1))
+
+(should (eql 1 (testcover-testcase-one 0)))
+;; ==== prog1-functions ====
+"Some forms are 1value if their first argument is 1value."
+;; ====
+(defun testcover-testcase-unwinder (arg)
+  (unwind-protect
+      (if ( > arg%%% 0)%%%
+        1
+        0)
+    (format "unwinding %s!" arg%%%)%%%))
+(defun testcover-testcase-divider (arg)
+  (unwind-protect
+      (/ 100 arg%%%)%%%
+      (format "unwinding! %s" arg%%%)%%%)%%%)
+
+(should (eq 0 (testcover-testcase-unwinder 0)))
+(should (eq 1 (testcover-testcase-divider 100)))
+
+;; ==== compose-functions ====
+"Some functions are 1value if all their arguments are 1value."
+;; ====
+(defconst testcover-testcase-count 3)
+(defun testcover-testcase-number ()
+  (+ 1 testcover-testcase-count))
+(defun testcover-testcase-more ()
+  (+ 1 (testcover-testcase-number) testcover-testcase-count))
+
+(should (equal (testcover-testcase-more) 8))
+
+;; ==== apply-quoted-symbol ====
+"Apply with a quoted function symbol treated as 1value if function is."
+;; ====
+(defun testcover-testcase-numlist (flag)
+  (if flag%%%
+      '(1 2 3)
+    '(4 5 6)))
+(defun testcover-testcase-sum (flag)
+  (apply '+ (testcover-testcase-numlist flag%%%)))
+(defun testcover-testcase-label ()
+  (apply 'message "edebug uses: %s %s" (list 1 2)!!!)!!!)
+
+(should (equal 6 (testcover-testcase-sum t)))
+
+;; ==== backquote-1value-bug-24509 ====
+"Commas within backquotes are recognized as non-1value."
+:expected-result :failed
+;; ====
+(defmacro testcover-testcase-lambda (&rest body)
+  `(lambda () ,@body))
+
+(defun testcover-testcase-example ()
+  (let ((lambda-1 (testcover-testcase-lambda (format "lambda-%d" 1))%%%)
+        (lambda-2 (testcover-testcase-lambda (format "lambda-%d" 2))%%%))
+    (concat (funcall lambda-1%%%)%%% " "
+            (funcall lambda-2%%%)%%%)%%%)%%%)
+
+(defmacro testcover-testcase-message-symbol (name)
+  `(message "%s" ',name))
+
+(defun testcover-testcase-example-2 ()
+  (concat
+   (testcover-testcase-message-symbol foo)%%%
+   (testcover-testcase-message-symbol bar)%%%)%%%)
+
+(should (equal "lambda-1 lambda-2" (testcover-testcase-example)))
+(should (equal "foobar" (testcover-testcase-example-2)))
+
+;; ==== pcase-bug-24688 ====
+"Testcover copes with condition-case within backquoted list."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-pcase (form)
+  (pcase form%%%
+    (`(condition-case ,var ,protected-form . ,handlers)
+     (list var%%% protected-form%%% handlers%%%)%%%)
+    (_ nil))%%%)
+
+(should (equal (testcover-testcase-pcase '(condition-case a
+                                              (/ 5 a)
+                                            (error 0)))
+               '(a (/ 5 a) ((error 0)))))
+
+;; ==== defun-in-backquote-bug-11307-and-24743 ====
+"Testcover handles defun forms within backquoted list."
+:expected-result :failed
+;; ====
+(defmacro testcover-testcase-defun (name &rest body)
+  (declare (debug (symbolp def-body)))
+  `(defun ,name () ,@body))
+
+(testcover-testcase-defun foo (+ 1 2))
+(testcover-testcase-defun bar (+ 3 4))
+(should (eql (foo) 3))
+(should (eql (bar) 7))
+
+;; ==== closure-1value-bug ====
+"Testcover does not mark closures as 1value."
+:expected-result :failed
+;; ====
+;; -*- lexical-binding:t -*-
+(setq testcover-testcase-foo nil)
+(setq testcover-testcase-bar 0)
+
+(defun testcover-testcase-baz (arg)
+  (setq testcover-testcase-foo
+        (lambda () (+ arg testcover-testcase-bar%%%))))
+
+(testcover-testcase-baz 2)
+(should (equal 2 (funcall testcover-testcase-foo)))
+(testcover-testcase-baz 3)
+(should (equal 3 (funcall testcover-testcase-foo)))
+
+;; ==== by-value-vs-by-reference-bug-25351 ====
+"An object created by a 1value expression may be modified by other code."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-ab ()
+  (list 'a 'b))
+(defun testcover-testcase-change-it (arg)
+  (setf (cadr arg%%%)%%% 'c)%%%
+  arg%%%)
+
+(should (equal (testcover-testcase-change-it (testcover-testcase-ab)) '(a c)))
+(should (equal (testcover-testcase-ab) '(a b)))
+
+;; ==== 1value-error-test ====
+"Forms wrapped by `1value' should always return the same value."
+;; ====
+(defun testcover-testcase-thing (arg)
+  (1value (list 1 arg 3)))
+
+(should (equal '(1 2 3) (testcover-testcase-thing 2)))
+(should-error (testcover-testcase-thing 3))
+
+;; ==== dotted-backquote ====
+"Testcover correctly instruments dotted backquoted lists."
+;; ====
+(defun testcover-testcase-dotted-bq (flag extras)
+  (let* ((bq
+          `(a b c . ,(and flag extras%%%))))
+    bq))
+
+(should (equal '(a b c) (testcover-testcase-dotted-bq nil '(d e))))
+(should (equal '(a b c d e) (testcover-testcase-dotted-bq t '(d e))))
+
+;; ==== backquoted-vector-bug-25316 ====
+"Testcover reinstruments within backquoted vectors."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-vec (a b c)
+  `[,a%%% ,(list b%%% c%%%)%%%]%%%)
+
+(defun testcover-testcase-vec-in-list (d e f)
+  `([[,d%%% ,e%%%] ,f%%%])%%%)
+
+(defun testcover-testcase-vec-arg (num)
+  (list `[,num%%%]%%%)%%%)
+
+(should (equal [1 (2 3)] (testcover-testcase-vec 1 2 3)))
+(should (equal '([[4 5] 6]) (testcover-testcase-vec-in-list 4 5 6)))
+(should (equal '([100]) (testcover-testcase-vec-arg 100)))
+
+;; ==== vector-in-macro-spec-bug-25316 ====
+"Testcover reinstruments within vectors."
+:expected-result :failed
+;; ====
+(defmacro testcover-testcase-nth-case (arg vec)
+  (declare (indent 1)
+           (debug (form (vector &rest form))))
+  `(eval (aref ,vec%%% ,arg%%%))%%%)
+
+(defun testcover-testcase-use-nth-case (choice val)
+  (testcover-testcase-nth-case choice
+                               [(+ 1 val!!!)!!!
+                                (- 1 val%%%)%%%
+                                (* 7 val)
+                                (/ 4 val!!!)!!!]))
+
+(should (eql 42 (testcover-testcase-use-nth-case 2 6)))
+(should (eql 49 (testcover-testcase-use-nth-case 2 7)))
+(should (eql 0 (testcover-testcase-use-nth-case 1 1 )))
+
+;; ==== mapcar-is-not-compose ====
+"Mapcar with 1value arguments is not 1value."
+:expected-result :failed
+;; ====
+(defvar testcover-testcase-num 0)
+(defun testcover-testcase-add-num (n)
+  (+ testcover-testcase-num n))
+(defun testcover-testcase-mapcar-sides ()
+  (mapcar 'testcover-testcase-add-num '(1 2 3)))
+
+(setq testcover-testcase-num 1)
+(should (equal (testcover-testcase-mapcar-sides) '(2 3 4)))
+(setq testcover-testcase-num 2)
+(should (equal (testcover-testcase-mapcar-sides) '(3 4 5)))
+
+;; ==== function-with-edebug-spec-bug-25316 ====
+"Functions can have edebug specs too.
+See c-make-font-lock-search-function for an example in the Emacs
+sources.  The other issue is that it's ok to use quote in an
+edebug spec, so testcover needs to cope with that."
+:expected-result :failed
+;; ====
+(defun testcover-testcase-make-function (forms)
+  `(lambda (flag) (if flag 0 ,@forms%%%))%%%)
+
+(def-edebug-spec testcover-testcase-make-function
+  (("quote" (&rest def-form))))
+
+(defun testcover-testcase-thing ()
+  (testcover-testcase-make-function '((+ 1 (+ 2 (+ 3 (+ 4 5))))))%%%)
+
+(defun testcover-testcase-use-thing ()
+  (funcall (testcover-testcase-thing)%%% nil)%%%)
+
+(should (equal (testcover-testcase-use-thing) 15))
+
+;; ==== backquoted-dotted-alist ====
+"Testcover can instrument a dotted alist constructed with backquote."
+;; ====
+(defun testcover-testcase-make-alist (expr entries)
+  `((0 . ,expr%%%) . ,entries%%%)%%%)
+
+(should (equal (testcover-testcase-make-alist "foo" '((1 . "bar") (2 . "baz")))
+               '((0 . "foo") (1 . "bar") (2 . "baz"))))
+
+;; ==== coverage-of-the-unknown-symbol-bug-25471 ====
+"Testcover correctly records coverage of code which uses `unknown'"
+:expected-result :failed
+;; ====
+(defun testcover-testcase-how-do-i-know-you (name)
+  (let ((val 'unknown))
+    (when (equal name%%% "Bob")%%%
+          (setq val 'known)!!!)
+    val%%%)%%%)
+
+(should (eq (testcover-testcase-how-do-i-know-you "Liz") 'unknown))
+
+;; testcases.el ends here.
diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el
new file mode 100644
index 0000000..d31379c
--- /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
-- 
2.9.3