diff options
| author | Gemini Lasswell | 2018-04-02 09:34:31 -0700 |
|---|---|---|
| committer | Gemini Lasswell | 2018-04-02 09:38:12 -0700 |
| commit | e3525385a87c92fdca6b3cf929797a731c688a3f (patch) | |
| tree | ce6438bf8882602ee71555554651b0f91e9f1d6f | |
| parent | d06c2e7a666fbc7aa0e7a9b134d9e373431d76bf (diff) | |
| download | emacs-e3525385a87c92fdca6b3cf929797a731c688a3f.tar.gz emacs-e3525385a87c92fdca6b3cf929797a731c688a3f.zip | |
Fix Testcover bug in handling of vectors containing dotted lists
* lisp/emacs-lisp/testcover.el (testcover-analyze-coverage-compose):
Handle dotted lists. Fix bug#30909.
* test/lisp/emacs-lisp/testcover-resources/testcases.el:
(dotted-list-in-vector-bug-30909): New test case.
(quotes-within-backquotes-bug-25316, dotted-backquote)
(quoted-backquote, backquoted-vector-bug-25316)
(vector-in-macro-spec-bug, backquoted-dotted-alist): Change
docstrings to mention analyzing code instead of reinstrumenting
it.
| -rw-r--r-- | lisp/emacs-lisp/testcover.el | 8 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/testcover-resources/testcases.el | 19 |
2 files changed, 18 insertions, 9 deletions
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index e0d2797c0cd..d48c79cd770 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el | |||
| @@ -644,9 +644,11 @@ are 1value." | |||
| 644 | "Analyze a list of FORMS for code coverage using FUNC. | 644 | "Analyze a list of FORMS for code coverage using FUNC. |
| 645 | The list is 1valued if all of its constituent elements are also 1valued." | 645 | The list is 1valued if all of its constituent elements are also 1valued." |
| 646 | (let ((result '1value)) | 646 | (let ((result '1value)) |
| 647 | (dolist (form forms) | 647 | (while (consp forms) |
| 648 | (let ((val (funcall func form))) | 648 | (setq result (testcover-coverage-combine result (funcall func (car forms)))) |
| 649 | (setq result (testcover-coverage-combine result val)))) | 649 | (setq forms (cdr forms))) |
| 650 | (when forms | ||
| 651 | (setq result (testcover-coverage-combine result (funcall func forms)))) | ||
| 650 | result)) | 652 | result)) |
| 651 | 653 | ||
| 652 | (defun testcover-analyze-coverage-backquote (bq-list) | 654 | (defun testcover-analyze-coverage-backquote (bq-list) |
diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el index c9703b03de0..69ef5b596be 100644 --- a/test/lisp/emacs-lisp/testcover-resources/testcases.el +++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el | |||
| @@ -226,7 +226,7 @@ | |||
| 226 | (should-not (testcover-testcase-cc nil)) | 226 | (should-not (testcover-testcase-cc nil)) |
| 227 | 227 | ||
| 228 | ;; ==== quotes-within-backquotes-bug-25316 ==== | 228 | ;; ==== quotes-within-backquotes-bug-25316 ==== |
| 229 | "Forms to instrument are found within quotes within backquotes." | 229 | "Forms to analyze are found within quotes within backquotes." |
| 230 | ;; ==== | 230 | ;; ==== |
| 231 | (defun testcover-testcase-make-list () | 231 | (defun testcover-testcase-make-list () |
| 232 | (list 'defun 'defvar)) | 232 | (list 'defun 'defvar)) |
| @@ -377,7 +377,7 @@ | |||
| 377 | (should-error (testcover-testcase-thing 3)) | 377 | (should-error (testcover-testcase-thing 3)) |
| 378 | 378 | ||
| 379 | ;; ==== dotted-backquote ==== | 379 | ;; ==== dotted-backquote ==== |
| 380 | "Testcover correctly instruments dotted backquoted lists." | 380 | "Testcover can analyze code inside dotted backquoted lists." |
| 381 | ;; ==== | 381 | ;; ==== |
| 382 | (defun testcover-testcase-dotted-bq (flag extras) | 382 | (defun testcover-testcase-dotted-bq (flag extras) |
| 383 | (let* ((bq | 383 | (let* ((bq |
| @@ -388,7 +388,7 @@ | |||
| 388 | (should (equal '(a b c d e) (testcover-testcase-dotted-bq t '(d e)))) | 388 | (should (equal '(a b c d e) (testcover-testcase-dotted-bq t '(d e)))) |
| 389 | 389 | ||
| 390 | ;; ==== quoted-backquote ==== | 390 | ;; ==== quoted-backquote ==== |
| 391 | "Testcover correctly instruments the quoted backquote symbol." | 391 | "Testcover correctly handles the quoted backquote symbol." |
| 392 | ;; ==== | 392 | ;; ==== |
| 393 | (defun testcover-testcase-special-symbols () | 393 | (defun testcover-testcase-special-symbols () |
| 394 | (list '\` '\, '\,@)) | 394 | (list '\` '\, '\,@)) |
| @@ -396,7 +396,7 @@ | |||
| 396 | (should (equal '(\` \, \,@) (testcover-testcase-special-symbols))) | 396 | (should (equal '(\` \, \,@) (testcover-testcase-special-symbols))) |
| 397 | 397 | ||
| 398 | ;; ==== backquoted-vector-bug-25316 ==== | 398 | ;; ==== backquoted-vector-bug-25316 ==== |
| 399 | "Testcover reinstruments within backquoted vectors." | 399 | "Testcover can analyze code within backquoted vectors." |
| 400 | ;; ==== | 400 | ;; ==== |
| 401 | (defun testcover-testcase-vec (a b c) | 401 | (defun testcover-testcase-vec (a b c) |
| 402 | `[,a%%% ,(list b%%% c%%%)%%%]%%%) | 402 | `[,a%%% ,(list b%%% c%%%)%%%]%%%) |
| @@ -411,8 +411,15 @@ | |||
| 411 | (should (equal '([[4 5] 6]) (testcover-testcase-vec-in-list 4 5 6))) | 411 | (should (equal '([[4 5] 6]) (testcover-testcase-vec-in-list 4 5 6))) |
| 412 | (should (equal '([100]) (testcover-testcase-vec-arg 100))) | 412 | (should (equal '([100]) (testcover-testcase-vec-arg 100))) |
| 413 | 413 | ||
| 414 | ;; ==== dotted-list-in-vector-bug-30909 ==== | ||
| 415 | "Testcover can analyze dotted pairs within vectors." | ||
| 416 | ;; ==== | ||
| 417 | (defun testcover-testcase-vectors-with-dotted-pairs () | ||
| 418 | (equal [(1 . "x")] [(1 2 . "y")])%%%) | ||
| 419 | (should-not (testcover-testcase-vectors-with-dotted-pairs)) | ||
| 420 | |||
| 414 | ;; ==== vector-in-macro-spec-bug-25316 ==== | 421 | ;; ==== vector-in-macro-spec-bug-25316 ==== |
| 415 | "Testcover reinstruments within vectors." | 422 | "Testcover can analyze code inside vectors." |
| 416 | ;; ==== | 423 | ;; ==== |
| 417 | (defmacro testcover-testcase-nth-case (arg vec) | 424 | (defmacro testcover-testcase-nth-case (arg vec) |
| 418 | (declare (indent 1) | 425 | (declare (indent 1) |
| @@ -466,7 +473,7 @@ regarding the odd-looking coverage result for the quoted form." | |||
| 466 | (should (equal (testcover-testcase-use-thing) 15)) | 473 | (should (equal (testcover-testcase-use-thing) 15)) |
| 467 | 474 | ||
| 468 | ;; ==== backquoted-dotted-alist ==== | 475 | ;; ==== backquoted-dotted-alist ==== |
| 469 | "Testcover can instrument a dotted alist constructed with backquote." | 476 | "Testcover can analyze a dotted alist constructed with backquote." |
| 470 | ;; ==== | 477 | ;; ==== |
| 471 | (defun testcover-testcase-make-alist (expr entries) | 478 | (defun testcover-testcase-make-alist (expr entries) |
| 472 | `((0 . ,expr%%%) . ,entries%%%)%%%) | 479 | `((0 . ,expr%%%) . ,entries%%%)%%%) |