1 files changed, 55 insertions, 45 deletions
diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el
index edb539f4c27..46040be1a6c 100644
--- a/test/lisp/emacs-lisp/testcover-resources/testcases.el
+++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el
@@ -1,23 +1,23 @@
 ;;;; testcases.el -- Test cases for testcover-tests.el
 
-;; Copyright (C) 2017 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2022 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.
-;;
+;; 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 this program.  If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -53,7 +53,6 @@
 
 ;; ==== constants-bug-25316 ====
 "Testcover doesn't splotch constants."
-:expected-result :failed
 ;; ====
 (defconst testcover-testcase-const "apples")
 (defun testcover-testcase-zero () 0)
@@ -76,15 +75,14 @@
 
 ;; ==== customize-defcustom-bug-25326 ====
 "Testcover doesn't prevent testing of defcustom values."
-:expected-result :failed
 ;; ====
 (defgroup testcover-testcase nil
-  "Test case for testcover"
+  "Test case for testcover."
   :group 'lisp
   :prefix "testcover-testcase-"
   :version "26.0")
 (defcustom testcover-testcase-flag t
-  "Test value used by testcover-tests.el"
+  "Test value used by testcover-tests.el."
   :type 'boolean
   :group 'testcover-testcase)
 (defun testcover-testcase-get-flag ()
@@ -113,7 +111,7 @@
 "Wrapping a form with noreturn prevents splotching."
 ;; ====
 (defun testcover-testcase-cancel (spacecraft)
-  (error "no destination for %s" spacecraft))
+  (error "No destination for %s" spacecraft))
 (defun testcover-testcase-launch (spacecraft planet)
   (if (null planet)
       (noreturn (testcover-testcase-cancel spacecraft%%%))
@@ -135,7 +133,6 @@
 
 ;; ==== 1-value-symbol-bug-25316 ====
 "Wrapping a form with 1value prevents splotching."
-:expected-result :failed
 ;; ====
 (defun testcover-testcase-always-zero (num)
   (- num%%% num%%%)%%%)
@@ -223,14 +220,13 @@
 (defun testcover-testcase-cc (arg)
   (condition-case nil
       (if (null arg%%%)%%%
-        (error "foo")
+        (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
+"Forms to analyze are found within quotes within backquotes."
 ;; ====
 (defun testcover-testcase-make-list ()
   (list 'defun 'defvar))
@@ -296,7 +292,6 @@
 
 ;; ==== backquote-1value-bug-24509 ====
 "Commas within backquotes are recognized as non-1value."
-:expected-result :failed
 ;; ====
 (defmacro testcover-testcase-lambda (&rest body)
   `(lambda () ,@body))
@@ -320,7 +315,6 @@
 
 ;; ==== pcase-bug-24688 ====
 "Testcover copes with condition-case within backquoted list."
-:expected-result :failed
 ;; ====
 (defun testcover-testcase-pcase (form)
   (pcase form%%%
@@ -335,7 +329,6 @@
 
 ;; ==== 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)))
@@ -348,7 +341,6 @@
 
 ;; ==== closure-1value-bug ====
 "Testcover does not mark closures as 1value."
-:expected-result :failed
 ;; ====
 ;; -*- lexical-binding:t -*-
 (setq testcover-testcase-foo nil)
@@ -365,7 +357,6 @@
 
 ;; ==== 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))
@@ -386,7 +377,7 @@
 (should-error (testcover-testcase-thing 3))
 
 ;; ==== dotted-backquote ====
-"Testcover correctly instruments dotted backquoted lists."
+"Testcover can analyze code inside dotted backquoted lists."
 ;; ====
 (defun testcover-testcase-dotted-bq (flag extras)
   (let* ((bq
@@ -396,9 +387,16 @@
 (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))))
 
+;; ==== quoted-backquote ====
+"Testcover correctly handles the quoted backquote symbol."
+;; ====
+(defun testcover-testcase-special-symbols ()
+  (list '\` '\, '\,@))
+
+(should (equal '(\` \, \,@) (testcover-testcase-special-symbols)))
+
 ;; ==== backquoted-vector-bug-25316 ====
-"Testcover reinstruments within backquoted vectors."
-:expected-result :failed
+"Testcover can analyze code within backquoted vectors."
 ;; ====
 (defun testcover-testcase-vec (a b c)
   `[,a%%% ,(list b%%% c%%%)%%%]%%%)
@@ -413,14 +411,20 @@
 (should (equal '([[4 5] 6]) (testcover-testcase-vec-in-list 4 5 6)))
 (should (equal '([100]) (testcover-testcase-vec-arg 100)))
 
+;; ==== dotted-list-in-vector-bug-30909 ====
+"Testcover can analyze dotted pairs within vectors."
+;; ====
+(defun testcover-testcase-vectors-with-dotted-pairs ()
+  (equal [(1 . "x")] [(1 2 . "y")])%%%)
+(should-not (testcover-testcase-vectors-with-dotted-pairs))
+
 ;; ==== vector-in-macro-spec-bug-25316 ====
-"Testcover reinstruments within vectors."
-:expected-result :failed
+"Testcover can analyze code inside vectors."
 ;; ====
 (defmacro testcover-testcase-nth-case (arg vec)
   (declare (indent 1)
            (debug (form (vector &rest form))))
-  `(eval (aref ,vec%%% ,arg%%%))%%%)
+  `(eval (aref ,vec%%% ,arg%%%) t)%%%)
 
 (defun testcover-testcase-use-nth-case (choice val)
   (testcover-testcase-nth-case choice
@@ -435,7 +439,6 @@
 
 ;; ==== 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)
@@ -450,10 +453,10 @@
 
 ;; ==== 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
+See `c-make-font-lock-search-function' for an example in the
+Emacs sources. `c-make-font-lock-search-function''s Edebug spec
+also contains a quote.  See comment in `testcover-analyze-coverage'
+regarding the odd-looking coverage result for the quoted form."
 ;; ====
 (defun testcover-testcase-make-function (forms)
   `(lambda (flag) (if flag 0 ,@forms%%%))%%%)
@@ -462,7 +465,7 @@ edebug spec, so testcover needs to cope with that."
   (("quote" (&rest def-form))))
 
 (defun testcover-testcase-thing ()
-  (testcover-testcase-make-function '((+ 1 (+ 2 (+ 3 (+ 4 5))))))%%%)
+  (testcover-testcase-make-function '(!!!(+ 1 !!!(+ 2 !!!(+ 3 !!!(+ 4 5)%%%)%%%)%%%)%%%))%%%)
 
 (defun testcover-testcase-use-thing ()
   (funcall (testcover-testcase-thing)%%% nil)%%%)
@@ -470,7 +473,7 @@ edebug spec, so testcover needs to cope with that."
 (should (equal (testcover-testcase-use-thing) 15))
 
 ;; ==== backquoted-dotted-alist ====
-"Testcover can instrument a dotted alist constructed with backquote."
+"Testcover can analyze a dotted alist constructed with backquote."
 ;; ====
 (defun testcover-testcase-make-alist (expr entries)
   `((0 . ,expr%%%) . ,entries%%%)%%%)
@@ -480,7 +483,6 @@ edebug spec, so testcover needs to cope with that."
 
 ;; ==== 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))
@@ -494,10 +496,18 @@ edebug spec, so testcover needs to cope with that."
 "Testcover captures and ignores circular list errors."
 ;; ====
 (defun testcover-testcase-cyc1 (a)
-  (let ((ls (make-list 10 a%%%)))
-    (nconc ls ls)
-    ls))
+  (let ((ls (make-list 10 a%%%)%%%))
+    (nconc ls%%% ls%%%)
+    ls)) ; The lack of a mark here is due to an ignored circular list error.
 (testcover-testcase-cyc1 1)
 (testcover-testcase-cyc1 1)
-
-;; testcases.el ends here.
+(defun testcover-testcase-cyc2 (a b)
+  (let ((ls1 (make-list 10 a%%%)%%%)
+        (ls2 (make-list 10 b)))
+    (nconc ls2 ls2)
+    (nconc ls1%%% ls2)
+    ls1))
+(testcover-testcase-cyc2 1 2)
+(testcover-testcase-cyc2 1 4)
+
+;;; testcases.el ends here