[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master d79cf63 2/3: Rewrite Testcover's internals, fixing
|
From: |
Gemini Lasswell |
|
Subject: |
[Emacs-diffs] master d79cf63 2/3: Rewrite Testcover's internals, fixing several bugs |
|
Date: |
Sun, 8 Oct 2017 19:14:51 -0400 (EDT) |
branch: master
commit d79cf638f278e50c22feb53d6ba556f5ce9d7853
Author: Gemini Lasswell <address@hidden>
Commit: Gemini Lasswell <address@hidden>
Rewrite Testcover's internals, fixing several bugs
* lisp/emacs-lisp/testcover.el: Rewrite the internals of Testcover
to analyze instrumented code instead of reinstrumenting it. Use new
hooks in Edebug to collect code coverage information at runtime
using Edebug's instrumentation.
Includes fixes for: (bug#11307) (bug#24509) (bug#24688) (bug#24743)
(bug#25316) (bug#25326).
(testcover-compose-functions): Remove mapcar.
(testcover-start, testcover-this-defun): Analyze code instead of
reinstrumenting it. Set edebug-behavior for each definition.
(testcover--read, testcover-1value, testcover-reinstrument)
(testcover-reinstrument-list, testcover-reinstrument-compose):
Deleted.
(testcover-after-instrumentation, testcover-init-definition)
(testcover-before): New functions.
(testcover-enter): Change call signature to match edebug-enter.
(testcover-after, testcover-mark): Add handling of 'maybe and
'noreturn.
(testcover-analyze-coverage, testcover-analyze-coverage-progn)
(testcover-analyze-coverage-edebug-after)
(testcover-analyze-coverage-wrapped-form)
(testcover-analyze-coverage-wrapped-application)
(testcover-analyze-coverage-compose)
(testcover-analyze-coverage-backquote)
(testcover-analyze-coverage-backquote-form)
(testcover-coverage-combine): New functions to analyze instrumented
code.
* lisp/emacs-lisp/gv.el: Modify edebug-after's gv-expander to
instrument in the setter as well as the getter.
* test/lisp/emacs-lisp/testcover-tests.el
(testcover-tests-run-test-case): Use `edebug-default-enter'
instead of `edebug-enter' to detect Edebug invocation
during tests.
* test/lisp/emacs-lisp/testcover-resources/testcases.el
(constants-bug-25316)
(customize-defcustom-bug-25326)
(1-value-symbol-bug-25316)
(quotes-within-backquotes-bug-25316)
(backquote-1value-bug-24509)
(pcase-bug-24688)
(defun-in-backquote-bug-11307-and-24743)
(closure-1value-bug)
(backquoted-vector-bug-25316)
(vector-in-macro-spec-bug-25316)
(mapcar-is-not-compose): Remove expected failure tags.
(function-with-edebug-spec-bug-25316): Remove expected failure tag
and modify expected result.
(quoted-backquote): New test.
* lisp/textmodes/rst.el: Remove workarounds for bugs in Testcover.
(rst-testcover-defcustom): Deleted.
* lisp/subr.el (1value): Remove incorrect description of
testcover-1value from docstring, replace with description of
Testcover's treatment of 1value.
---
lisp/emacs-lisp/gv.el | 4 +-
lisp/emacs-lisp/testcover.el | 658 ++++++++++++---------
lisp/subr.el | 4 +-
lisp/textmodes/rst.el | 47 --
.../emacs-lisp/testcover-resources/testcases.el | 29 +-
test/lisp/emacs-lisp/testcover-tests.el | 12 +-
6 files changed, 392 insertions(+), 362 deletions(-)
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 892d6e9..777b955 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -303,7 +303,9 @@ The return value is the last VAL in the list.
(lambda (do before index place)
(gv-letplace (getter setter) place
(funcall do `(edebug-after ,before ,index ,getter)
- setter))))
+ (lambda (store)
+ `(progn (edebug-after ,before ,index ,getter)
+ ,(funcall setter store)))))))
;;; The common generalized variables.
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 691860b..320c43b 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -33,7 +33,9 @@
;; that has a splotch.
;; * Basic algorithm: use `edebug' to mark up the function text with
-;; instrumentation callbacks, then replace edebug's callbacks with ours.
+;; instrumentation callbacks, walk the instrumented code looking for
+;; forms which don't return or always return the same value, then use
+;; Edebug's before and after hooks to replace its code coverage with ours.
;; * To show good coverage, we want to see two values for every form, except
;; functions that always return the same value and `defconst' variables
;; need show only one value for good coverage. To avoid the brown
@@ -89,16 +91,14 @@ these. This list is quite incomplete!"
buffer-disable-undo buffer-enable-undo current-global-map
deactivate-mark delete-backward-char delete-char delete-region ding
forward-char function* insert insert-and-inherit kill-all-local-variables
- kill-line kill-paragraph kill-region kill-sexp lambda
+ kill-line kill-paragraph kill-region kill-sexp
minibuffer-complete-and-exit narrow-to-region next-line push-mark
put-text-property run-hooks set-match-data signal
substitute-key-definition suppress-keymap undo use-local-map while widen
yank)
- "Functions that always return the same value. No brown splotch is shown
-for these. This list is quite incomplete! Notes: Nobody ever changes the
-current global map. The macro `lambda' is self-evaluating, hence always
-returns the same value (the function it defines may return varying values
-when called)."
+ "Functions that always return the same value, according to `equal'.
+No brown splotch is shown for these. This list is quite
+incomplete! Notes: Nobody ever changes the current global map."
:group 'testcover
:type '(repeat symbol))
@@ -111,7 +111,7 @@ them as having returned nil just before calling them."
(defcustom testcover-compose-functions
'(+ - * / = append length list make-keymap make-sparse-keymap
- mapcar message propertize replace-regexp-in-string
+ message propertize replace-regexp-in-string
run-with-idle-timer set-buffer-modified-p)
"Functions that are 1-valued if all their args are either constants or
calls to one of the `testcover-1value-functions', so if that's true then no
@@ -186,19 +186,21 @@ call to one of the `testcover-1value-functions'."
;;;###autoload
(defun testcover-start (filename &optional byte-compile)
- "Uses edebug to instrument all macros and functions in FILENAME, then
-changes the instrumentation from edebug to testcover--much faster, no
-problems with type-ahead or post-command-hook, etc. If BYTE-COMPILE is
-non-nil, byte-compiles each function after instrumenting."
+ "Use Edebug to instrument for coverage all macros and functions in FILENAME.
+If BYTE-COMPILE is non-nil, byte compile each function after instrumenting."
(interactive "fStart covering file: ")
- (let ((buf (find-file filename))
- (load-read-function load-read-function))
- (add-function :around load-read-function
- #'testcover--read)
- (setq edebug-form-data nil
- testcover-module-constants nil
- testcover-module-1value-functions nil)
- (eval-buffer buf))
+ (let ((buf (find-file filename)))
+ (setq edebug-form-data nil
+ testcover-module-constants nil
+ testcover-module-1value-functions nil
+ testcover-module-potentially-1value-functions nil)
+ (cl-letf ((edebug-all-defs t)
+ (edebug-after-instrumentation-functions)
+ (edebug-new-definition-functions))
+ (add-hook 'edebug-after-instrumentation-functions
'testcover-after-instrumentation)
+ (add-hook 'edebug-new-definition-functions 'testcover-init-definition)
+ (remove-hook 'edebug-new-definition-functions
'edebug-announce-definition)
+ (eval-buffer buf)))
(when byte-compile
(dolist (x (reverse edebug-form-data))
(when (fboundp (car x))
@@ -209,229 +211,13 @@ non-nil, byte-compiles each function after
instrumenting."
(defun testcover-this-defun ()
"Start coverage on function under point."
(interactive)
- (let ((x (let ((edebug-all-defs t))
- (symbol-function (eval-defun nil)))))
- (testcover-reinstrument x)
- x))
-
-(defun testcover--read (orig &optional stream)
- "Read a form using edebug, changing edebug callbacks to testcover callbacks."
- (or stream (setq stream standard-input))
- (if (eq stream (current-buffer))
- (let ((x (let ((edebug-all-defs t))
- (edebug-read-and-maybe-wrap-form))))
- (testcover-reinstrument x)
- x)
- (funcall (or orig #'read) stream)))
-
-(defun testcover-reinstrument (form)
- "Reinstruments FORM to use testcover instead of edebug. This
-function modifies the list that FORM points to. Result is nil if
-FORM should return multiple values, t if should always return same
-value, `maybe' if either is acceptable."
- (let ((fun (car-safe form))
- id val)
- (cond
- ((not fun) ;Atom
- (when (or (not (symbolp form))
- (memq form testcover-constants)
- (memq form testcover-module-constants))
- t))
- ((consp fun) ;Embedded list
- (testcover-reinstrument fun)
- (testcover-reinstrument-list (cdr form))
- nil)
- ((or (memq fun testcover-1value-functions)
- (memq fun testcover-module-1value-functions))
- ;;Should always return same value
- (testcover-reinstrument-list (cdr form))
- t)
- ((or (memq fun testcover-potentially-1value-functions)
- (memq fun testcover-module-potentially-1value-functions))
- ;;Might always return same value
- (testcover-reinstrument-list (cdr form))
- 'maybe)
- ((memq fun testcover-progn-functions)
- ;;1-valued if last argument is
- (testcover-reinstrument-list (cdr form)))
- ((memq fun testcover-prog1-functions)
- ;;1-valued if first argument is
- (testcover-reinstrument-list (cddr form))
- (testcover-reinstrument (cadr form)))
- ((memq fun testcover-compose-functions)
- ;;1-valued if all arguments are. Potentially 1-valued if all
- ;;arguments are either definitely or potentially.
- (testcover-reinstrument-compose (cdr form) 'testcover-reinstrument))
- ((eq fun 'edebug-enter)
- ;;(edebug-enter 'SYM ARGS #'(lambda nil FORMS))
- ;; => (testcover-enter 'SYM #'(lambda nil FORMS))
- (setcar form 'testcover-enter)
- (setcdr (nthcdr 1 form) (nthcdr 3 form))
- (let ((testcover-vector (get (cadr (cadr form)) 'edebug-coverage)))
- (testcover-reinstrument-list (nthcdr 2 (cadr (nth 2 form))))))
- ((eq fun 'edebug-after)
- ;;(edebug-after (edebug-before XXX) YYY FORM)
- ;; => (testcover-after YYY FORM), mark XXX as ok-coverage
- (unless (eq (cadr form) 0)
- (aset testcover-vector (cadr (cadr form)) 'ok-coverage))
- (setq id (nth 2 form))
- (setcdr form (nthcdr 2 form))
- (setq val (testcover-reinstrument (nth 2 form)))
- (setcar form (if (eq val t)
- 'testcover-1value
- 'testcover-after))
- (when val
- ;;1-valued or potentially 1-valued
- (aset testcover-vector id '1value))
- (cond
- ((memq (car-safe (nth 2 form)) testcover-noreturn-functions)
- ;;This function won't return, so set the value in advance
- ;;(edebug-after (edebug-before XXX) YYY FORM)
- ;; => (progn (edebug-after YYY nil) FORM)
- (setcar (cdr form) `(,(car form) ,id nil))
- (setcar form 'progn)
- (aset testcover-vector id '1value)
- (setq val t))
- ((eq (car-safe (nth 2 form)) '1value)
- ;;This function is always supposed to return the same value
- (setq val t)
- (aset testcover-vector id '1value)
- (setcar form 'testcover-1value)))
- val)
- ((eq fun 'defun)
- (setq val (testcover-reinstrument-list (nthcdr 3 form)))
- (when (eq val t)
- (push (cadr form) testcover-module-1value-functions))
- (when (eq val 'maybe)
- (push (cadr form) testcover-module-potentially-1value-functions)))
- ((memq fun '(defconst defcustom))
- ;;Define this symbol as 1-valued
- (push (cadr form) testcover-module-constants)
- (testcover-reinstrument-list (cddr form)))
- ((memq fun '(dotimes dolist))
- ;;Always returns third value from SPEC
- (testcover-reinstrument-list (cddr form))
- (setq val (testcover-reinstrument-list (cadr form)))
- (if (nth 2 (cadr form))
- val
- ;;No third value, always returns nil
- t))
- ((memq fun '(let let*))
- ;;Special parsing for second argument
- (mapc 'testcover-reinstrument-list (cadr form))
- (testcover-reinstrument-list (cddr form)))
- ((eq fun 'if)
- ;;Potentially 1-valued if both THEN and ELSE clauses are
- (testcover-reinstrument (cadr form))
- (let ((then (testcover-reinstrument (nth 2 form)))
- (else (testcover-reinstrument-list (nthcdr 3 form))))
- (and then else 'maybe)))
- ((eq fun 'cond)
- ;;Potentially 1-valued if all clauses are
- (when (testcover-reinstrument-compose (cdr form)
- 'testcover-reinstrument-list)
- 'maybe))
- ((eq fun 'condition-case)
- ;;Potentially 1-valued if BODYFORM is and all HANDLERS are
- (let ((body (testcover-reinstrument (nth 2 form)))
- (errs (testcover-reinstrument-compose
- (mapcar #'cdr (nthcdr 3 form))
- 'testcover-reinstrument-list)))
- (and body errs 'maybe)))
- ((eq fun 'quote)
- ;;Don't reinstrument what's inside!
- ;;This doesn't apply within a backquote
- t)
- ((eq fun '\`)
- ;;Quotes are not special within backquotes
- (let ((testcover-1value-functions
- (cons 'quote testcover-1value-functions)))
- (testcover-reinstrument (cadr form))))
- ((eq fun '\,)
- ;;In commas inside backquotes, quotes are special again
- (let ((testcover-1value-functions
- (remq 'quote testcover-1value-functions)))
- (testcover-reinstrument (cadr form))))
- ((eq fun '1value)
- ;;Hack - pretend the arg is 1-valued here
- (cond
- ((symbolp (cadr form))
- ;;A pseudoconstant variable
- t)
- ((and (eq (car (cadr form)) 'edebug-after)
- (symbolp (nth 3 (cadr form))))
- ;;Reference to pseudoconstant
- (aset testcover-vector (nth 2 (cadr form)) '1value)
- (setcar (cdr form) `(testcover-1value ,(nth 2 (cadr form))
- ,(nth 3 (cadr form))))
- t)
- (t
- (setq id (car (if (eq (car (cadr form)) 'edebug-after)
- (nth 3 (cadr form))
- (cadr form))))
- (let ((testcover-1value-functions
- (cons id testcover-1value-functions)))
- (testcover-reinstrument (cadr form))))))
- ((eq fun 'noreturn)
- ;;Hack - pretend the arg has no return
- (cond
- ((symbolp (cadr form))
- ;;A pseudoconstant variable
- 'maybe)
- ((and (eq (car (cadr form)) 'edebug-after)
- (symbolp (nth 3 (cadr form))))
- ;;Reference to pseudoconstant
- (aset testcover-vector (nth 2 (cadr form)) '1value)
- (setcar (cdr form) `(progn (testcover-after ,(nth 2 (cadr form)) nil)
- ,(nth 3 (cadr form))))
- 'maybe)
- (t
- (setq id (car (if (eq (car (cadr form)) 'edebug-after)
- (nth 3 (cadr form))
- (cadr form))))
- (let ((testcover-noreturn-functions
- (cons id testcover-noreturn-functions)))
- (testcover-reinstrument (cadr form))))))
- ((and (eq fun 'apply)
- (eq (car-safe (cadr form)) 'quote)
- (symbolp (cadr (cadr form))))
- ;;Apply of a constant symbol. Process as 1value or noreturn
- ;;depending on symbol.
- (setq fun (cons (cadr (cadr form)) (cddr form))
- val (testcover-reinstrument fun))
- (setcdr (cdr form) (cdr fun))
- val)
- (t ;Some other function or weird thing
- (testcover-reinstrument-list (cdr form))
- nil))))
-
-(defun testcover-reinstrument-list (list)
- "Reinstruments each form in LIST to use testcover instead of edebug.
-This function modifies the forms in LIST. Result is `testcover-reinstrument's
-value for the last form in LIST. If the LIST is empty, its evaluation will
-always be nil, so we return t for 1-valued."
- (let ((result t))
- (while (consp list)
- (setq result (testcover-reinstrument (pop list))))
- result))
-
-(defun testcover-reinstrument-compose (list fun)
- "For a compositional function, the result is 1-valued if all
-arguments are, potentially 1-valued if all arguments are either
-definitely or potentially 1-valued, and multi-valued otherwise.
-FUN should be `testcover-reinstrument' for compositional functions,
- `testcover-reinstrument-list' for clauses in a `cond'."
- (let ((result t))
- (mapc #'(lambda (x)
- (setq x (funcall fun x))
- (cond
- ((eq result t)
- (setq result x))
- ((eq result 'maybe)
- (when (not x)
- (setq result nil)))))
- list)
- result))
+ (cl-letf ((edebug-all-defs t)
+ (edebug-after-instrumentation-functions)
+ (edebug-new-definition-functions))
+ (add-hook 'edebug-after-instrumentation-functions
'testcover-after-instrumentation)
+ (add-hook 'edebug-new-definition-functions 'testcover-init-definition)
+ (remove-hook 'edebug-new-definition-functions 'edebug-announce-definition)
+ (eval-defun nil)))
(defun testcover-end (filename)
"Turn off instrumentation of all macros and functions in FILENAME."
@@ -444,48 +230,61 @@ FUN should be `testcover-reinstrument' for compositional
functions,
;;; Accumulate coverage data
;;;=========================================================================
-(defun testcover-enter (testcover-sym testcover-fun)
- "Internal function for coverage testing. Invokes TESTCOVER-FUN while
-binding `testcover-vector' to the code-coverage vector for TESTCOVER-SYM
-\(the name of the current function)."
- (let ((testcover-vector (get testcover-sym 'edebug-coverage)))
- (funcall testcover-fun)))
-
-(defun testcover-after (idx val)
- "Internal function for coverage testing. Returns VAL after installing it in
-`testcover-vector' at offset IDX."
- (declare (gv-expander (lambda (do)
- (gv-letplace (getter setter) val
- (funcall do getter
- (lambda (store)
- `(progn (testcover-after ,idx ,getter)
- ,(funcall setter store))))))))
- (cond
- ((eq (aref testcover-vector idx) 'unknown)
- (aset testcover-vector idx val))
- ((not (condition-case ()
- (equal (aref testcover-vector idx) val)
- ;; TODO: Actually check circular lists for equality.
- (circular-list nil)))
- (aset testcover-vector idx 'ok-coverage)))
- val)
-
-(defun testcover-1value (idx val)
- "Internal function for coverage testing. Returns VAL after installing it in
-`testcover-vector' at offset IDX. Error if FORM does not always return the
-same value during coverage testing."
- (cond
- ((eq (aref testcover-vector idx) '1value)
- (aset testcover-vector idx (cons '1value val)))
- ((not (and (eq (car-safe (aref testcover-vector idx)) '1value)
- (condition-case ()
- (equal (cdr (aref testcover-vector idx)) val)
- ;; TODO: Actually check circular lists for equality.
- (circular-list nil))))
- (error "Value of form marked with `1value' does vary: %s" val)))
- val)
-
-
+(defun testcover-after-instrumentation (form)
+ "Analyze FORM for code coverage."
+ (testcover-analyze-coverage form))
+
+(defun testcover-init-definition (sym)
+ "Mark SYM as under test coverage."
+ (message "Testcover: %s" edebug-def-name)
+ (put sym 'edebug-behavior 'testcover))
+
+(defun testcover-enter (func _args body)
+ "Begin execution of a function under coverage testing.
+Bind `testcover-vector' to the code-coverage vector for FUNC and
+return the result of evaluating BODY."
+ (let ((testcover-vector (get func 'edebug-coverage)))
+ (funcall body)))
+
+(defun testcover-before (before-index)
+ "Update code coverage before a form is evaluated.
+BEFORE-INDEX is the form's index into the code-coverage vector."
+ (let ((before-entry (aref testcover-vector before-index)))
+ (when (eq (car-safe before-entry) 'noreturn)
+ (let* ((after-index (cdr before-entry)))
+ (aset testcover-vector after-index 'ok-coverage)))))
+
+(defun testcover-after (_before-index after-index value)
+ "Update code coverage with the result of a form's evaluation.
+AFTER-INDEX is the form's index into the code-coverage
+vector. Return VALUE."
+ (let ((old-result (aref testcover-vector after-index)))
+ (cond
+ ((eq 'unknown old-result)
+ (aset testcover-vector after-index value))
+ ((eq 'maybe old-result)
+ (aset testcover-vector after-index 'ok-coverage))
+ ((eq '1value old-result)
+ (aset testcover-vector after-index
+ (cons old-result value)))
+ ((and (eq (car-safe old-result) '1value)
+ (not (condition-case ()
+ (equal (cdr old-result) value)
+ ;; TODO: Actually check circular lists for equality.
+ (circular-list t))))
+ (error "Value of form marked with `1value' does vary: %s" value))
+ ;; Test if a different result.
+ ((not (condition-case ()
+ (equal value old-result)
+ ;; TODO: Actually check circular lists for equality.
+ (circular-list nil)))
+ (aset testcover-vector after-index 'ok-coverage))))
+ value)
+
+;; Add these behaviors to Edebug.
+(unless (assoc 'testcover edebug-behavior-alist)
+ (push '(testcover testcover-enter testcover-before testcover-after)
+ edebug-behavior-alist))
;;;=========================================================================
;;; Display the coverage data as color splotches on your code.
@@ -517,12 +316,13 @@ eliminated by adding more test cases."
(while (> len 0)
(setq len (1- len)
data (aref coverage len))
- (when (and (not (eq data 'ok-coverage))
- (not (eq (car-safe data) '1value))
- (setq j (+ def-mark (aref points len))))
+ (when (and (not (eq data 'ok-coverage))
+ (not (memq (car-safe data)
+ '(1value maybe noreturn)))
+ (setq j (+ def-mark (aref points len))))
(setq ov (make-overlay (1- j) j))
(overlay-put ov 'face
- (if (memq data '(unknown 1value))
+ (if (memq data '(unknown maybe 1value))
'testcover-nohits
'testcover-1value))))
(set-buffer-modified-p changed))))
@@ -553,4 +353,284 @@ coverage tests. This function creates many overlays."
(goto-char (next-overlay-change (point)))
(end-of-line))
+
+;;; Coverage Analysis
+
+;; The top level function for initializing code coverage is
+;; `testcover-analyze-coverage', which recursively walks the form it is
+;; passed, which should have already been instrumented by
+;; edebug-read-and-maybe-wrap-form, and initializes the associated
+;; code coverage vectors, which should have already been created by
+;; `edebug-clear-coverage'.
+;;
+;; The purpose of the analysis is to identify forms which can only
+;; ever return a single value. These forms can be considered to have
+;; adequate code coverage even if only executed once. In addition,
+;; forms which will never return, such as error signals, can be
+;; identified and treated correctly.
+;;
+;; The code coverage vector entries for the beginnings of forms will
+;; be changed to `ok-coverage.', except for the beginnings of forms
+;; which should never return, which will be changed to
+;; (noreturn . AFTER-INDEX) so that testcover-before can set the entry
+;; for the end of the form just before it is executed.
+;;
+;; Entries for the ends of forms may be changed to `1value' if
+;; analysis determines the form will only ever return a single value,
+;; or `maybe' if the form could potentially only ever return a single
+;; value.
+;;
+;; An example of a potentially 1-valued form is an `and' whose last
+;; term is 1-valued, in case the last term is always nil. Example:
+;;
+;; (and (< (point) 1000) (forward-char 10))
+;;
+;; This form always returns nil. Similarly, `or', `if', and `cond'
+;; are treated as potentially 1-valued if all clauses are, in case
+;; those values are always nil. Unlike truly 1-valued functions, it
+;; is not an error if these "potentially" 1-valued forms actually
+;; return differing values.
+
+(defun testcover-analyze-coverage (form)
+ "Analyze FORM and initialize coverage vectors for definitions found within.
+Return 1value, maybe or nil depending on if the form is determined
+to return only a single value, potentially return only a single value,
+or return multiple values."
+ (pcase form
+ (`(edebug-enter ',sym ,_ (function (lambda nil . ,body)))
+ (let ((testcover-vector (get sym 'edebug-coverage)))
+ (testcover-analyze-coverage-progn body)))
+
+ (`(edebug-after ,(and before-form
+ (or `(edebug-before ,before-id) before-id))
+ ,after-id ,wrapped-form)
+ (testcover-analyze-coverage-edebug-after
+ form before-form before-id after-id wrapped-form))
+
+ (`(defconst ,sym . ,args)
+ (push sym testcover-module-constants)
+ (testcover-analyze-coverage-progn args)
+ '1value)
+
+ (`(defun ,name ,_ . ,doc-and-body)
+ (let ((val (testcover-analyze-coverage-progn doc-and-body)))
+ (cl-case val
+ ((1value) (push name testcover-module-1value-functions))
+ ((maybe) (push name testcover-module-potentially-1value-functions)))
+ nil))
+
+ (`(quote . ,_)
+ ;; A quoted form is 1value. Edebug could have instrumented
+ ;; something inside the form if an Edebug spec contained a quote.
+ ;; It's also possible that the quoted form is a circular object.
+ ;; To avoid infinite recursion, don't examine quoted objects.
+ ;; This will cause the coverage marks on an instrumented quoted
+ ;; form to look odd. See bug#25316.
+ '1value)
+
+ (`(\` ,bq-form)
+ (testcover-analyze-coverage-backquote-form bq-form))
+
+ ((or 't 'nil (pred keywordp))
+ '1value)
+
+ ((pred vectorp)
+ (testcover-analyze-coverage-compose (append form nil)
+ #'testcover-analyze-coverage))
+
+ ((pred symbolp)
+ nil)
+
+ ((pred atom)
+ '1value)
+
+ (_
+ ;; Whatever we have here, it's not wrapped, so treat it as a list of
forms.
+ (testcover-analyze-coverage-compose form #'testcover-analyze-coverage))))
+
+(defun testcover-analyze-coverage-progn (forms)
+ "Analyze FORMS, which should be a list of forms, for code coverage.
+Analyze all the forms in FORMS and return 1value, maybe or nil
+depending on the analysis of the last one. Find the coverage
+vectors referenced by `edebug-enter' forms nested within FORMS and
+update them with the results of the analysis."
+ (let ((result '1value))
+ (while (consp forms)
+ (setq result (testcover-analyze-coverage (pop forms))))
+ result))
+
+(defun testcover-analyze-coverage-edebug-after (_form before-form before-id
+ after-id wrapped-form
+ &optional wrapper)
+ "Analyze a _FORM wrapped by `edebug-after' for code coverage.
+_FORM should be either:
+ (edebug-after (edebug-before BEFORE-ID) AFTER-ID WRAPPED-FORM)
+or:
+ (edebug-after 0 AFTER-ID WRAPPED-FORM)
+
+where BEFORE-FORM is bound to either (edebug-before BEFORE-ID) or
+0. WRAPPER may be 1value or noreturn, and if so it forces the
+form to be treated accordingly."
+ (let (val)
+ (unless (eql before-form 0)
+ (aset testcover-vector before-id 'ok-coverage))
+
+ (setq val (testcover-analyze-coverage-wrapped-form wrapped-form))
+ (when (or (eq wrapper '1value) val)
+ ;; The form is 1-valued or potentially 1-valued.
+ (aset testcover-vector after-id (or val '1value)))
+
+ (cond
+ ((or (eq wrapper 'noreturn)
+ (memq (car-safe wrapped-form) testcover-noreturn-functions))
+ ;; This function won't return, so indicate to testcover-before that
+ ;; it should record coverage.
+ (aset testcover-vector before-id (cons 'noreturn after-id))
+ (aset testcover-vector after-id '1value)
+ (setq val '1value))
+
+ ((eq (car-safe wrapped-form) '1value)
+ ;; This function is always supposed to return the same value.
+ (setq val '1value)
+ (aset testcover-vector after-id '1value)))
+ val))
+
+(defun testcover-analyze-coverage-wrapped-form (form)
+ "Analyze a FORM for code coverage which was wrapped by `edebug-after'.
+FORM is treated as if it will be evaluated."
+ (pcase form
+ ((pred keywordp)
+ '1value)
+ ((pred symbolp)
+ (when (or (memq form testcover-constants)
+ (memq form testcover-module-constants))
+ '1value))
+ ((pred atom)
+ '1value)
+ (`(\` ,bq-form)
+ (testcover-analyze-coverage-backquote-form bq-form))
+ (`(defconst ,sym ,val . ,_)
+ (push sym testcover-module-constants)
+ (testcover-analyze-coverage val)
+ '1value)
+ (`(,(or 'dotimes 'dolist) (,_ ,expr . ,result) . ,body)
+ ;; These always return RESULT if provided.
+ (testcover-analyze-coverage expr)
+ (testcover-analyze-coverage-progn body)
+ (let ((val (testcover-analyze-coverage-progn result)))
+ ;; If the third value is not present, the loop always returns nil.
+ (if result val '1value)))
+ (`(,(or 'let 'let*) ,bindings . ,body)
+ (testcover-analyze-coverage-progn bindings)
+ (testcover-analyze-coverage-progn body))
+ (`(if ,test ,then-form . ,else-body)
+ ;; `if' is potentially 1-valued if both THEN and ELSE clauses are.
+ (testcover-analyze-coverage test)
+ (let ((then (testcover-analyze-coverage then-form))
+ (else (testcover-analyze-coverage else-body)))
+ (and then else 'maybe)))
+ (`(cond . ,clauses)
+ ;; `cond' is potentially 1-valued if all clauses are.
+ (when (testcover-analyze-coverage-compose clauses
#'testcover-analyze-coverage-progn)
+ 'maybe))
+ (`(condition-case ,_ ,body-form . ,handlers)
+ ;; `condition-case' is potentially 1-valued if BODY-FORM is and all
+ ;; HANDLERS are.
+ (let ((body (testcover-analyze-coverage body-form))
+ (errs (testcover-analyze-coverage-compose
+ (mapcar #'cdr handlers)
+ #'testcover-analyze-coverage-progn)))
+ (and body errs 'maybe)))
+ (`(apply (quote ,(and func (pred symbolp))) . ,args)
+ ;; Process application of a constant symbol as 1value or noreturn
+ ;; depending on the symbol.
+ (let ((temp-form (cons func args)))
+ (testcover-analyze-coverage-wrapped-form temp-form)))
+ (`(,(and func (or '1value 'noreturn)) ,inner-form)
+ ;; 1value and noreturn change how the edebug-after they wrap is handled.
+ (let ((val (if (eq func '1value) '1value 'maybe)))
+ (pcase inner-form
+ (`(edebug-after ,(and before-form
+ (or `(edebug-before ,before-id) before-id))
+ ,after-id ,wrapped-form)
+ (testcover-analyze-coverage-edebug-after inner-form before-form
+ before-id after-id
+ wrapped-form func))
+ (_ (testcover-analyze-coverage inner-form)))
+ val))
+ (`(,func . ,args)
+ (testcover-analyze-coverage-wrapped-application func args))))
+
+(defun testcover-analyze-coverage-wrapped-application (func args)
+ "Analyze the application of FUNC to ARGS for code coverage."
+ (cond
+ ((eq func 'quote) '1value)
+ ((or (memq func testcover-1value-functions)
+ (memq func testcover-module-1value-functions))
+ ;; The function should always return the same value.
+ (testcover-analyze-coverage-progn args)
+ '1value)
+ ((or (memq func testcover-potentially-1value-functions)
+ (memq func testcover-module-potentially-1value-functions))
+ ;; The function might always return the same value.
+ (testcover-analyze-coverage-progn args)
+ 'maybe)
+ ((memq func testcover-progn-functions)
+ ;; The function is 1-valued if the last argument is.
+ (testcover-analyze-coverage-progn args))
+ ((memq func testcover-prog1-functions)
+ ;; The function is 1-valued if first argument is.
+ (testcover-analyze-coverage-progn (cdr args))
+ (testcover-analyze-coverage (car args)))
+ ((memq func testcover-compose-functions)
+ ;; The function is 1-valued if all arguments are, and potentially
+ ;; 1-valued if all arguments are either definitely or potentially.
+ (testcover-analyze-coverage-compose args #'testcover-analyze-coverage))
+ (t (testcover-analyze-coverage-progn args)
+ nil)))
+
+(defun testcover-coverage-combine (result val)
+ "Combine RESULT with VAL and return the new result.
+If either argument is nil, return nil, otherwise if either
+argument is maybe, return maybe. Return 1value only if both arguments
+are 1value."
+ (cl-case val
+ (1value result)
+ (maybe (and result 'maybe))
+ (nil nil)))
+
+(defun testcover-analyze-coverage-compose (forms func)
+ "Analyze a list of FORMS for code coverage using FUNC.
+The list is 1valued if all of its constituent elements are also 1valued."
+ (let ((result '1value))
+ (dolist (form forms)
+ (let ((val (funcall func form)))
+ (setq result (testcover-coverage-combine result val))))
+ result))
+
+(defun testcover-analyze-coverage-backquote (bq-list)
+ "Analyze BQ-LIST, the body of a backquoted list, for code coverage."
+ (let ((result '1value))
+ (while (consp bq-list)
+ (let ((form (car bq-list))
+ val)
+ (if (memq form (list '\, '\,@))
+ ;; Correctly handle `(foo bar . ,(baz).
+ (progn
+ (setq val (testcover-analyze-coverage (cdr bq-list)))
+ (setq bq-list nil))
+ (setq val (testcover-analyze-coverage-backquote-form form))
+ (setq bq-list (cdr bq-list)))
+ (setq result (testcover-coverage-combine result val))))
+ result))
+
+(defun testcover-analyze-coverage-backquote-form (form)
+ "Analyze a single FORM from a backquoted list for code coverage."
+ (cond
+ ((vectorp form) (testcover-analyze-coverage-backquote (append form nil)))
+ ((atom form) '1value)
+ ((memq (car form) (list '\, '\,@))
+ (testcover-analyze-coverage (cadr form)))
+ (t (testcover-analyze-coverage-backquote form))))
+
;; testcover.el ends here.
diff --git a/lisp/subr.el b/lisp/subr.el
index d2fefe0..c1eae8d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -78,8 +78,8 @@ If FORM does return, signal an error."
(defmacro 1value (form)
"Evaluate FORM, expecting a constant return value.
-This is the global do-nothing version. There is also `testcover-1value'
-that complains if FORM ever does return differing values."
+If FORM returns differing values when running under Testcover,
+Testcover will raise an error."
(declare (debug t))
form)
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 5534294..5eb64c8 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -128,27 +128,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support for `testcover'
-(when (and (boundp 'testcover-1value-functions)
- (boundp 'testcover-compose-functions))
- ;; Below `lambda' is used in a loop with varying parameters and is thus not
- ;; 1valued.
- (setq testcover-1value-functions
- (delq 'lambda testcover-1value-functions))
- (add-to-list 'testcover-compose-functions 'lambda))
-
-(defun rst-testcover-defcustom ()
- "Remove all customized variables from `testcover-module-constants'.
-This seems to be a bug in `testcover': `defcustom' variables are
-considered constants. Revert it with this function after each `defcustom'."
- (when (boundp 'testcover-module-constants)
- (setq testcover-module-constants
- (delq nil
- (mapcar
- #'(lambda (sym)
- (if (not (plist-member (symbol-plist sym) 'standard-value))
- sym))
- testcover-module-constants)))))
-
(defun rst-testcover-add-compose (fun)
"Add FUN to `testcover-compose-functions'."
(when (boundp 'testcover-compose-functions)
@@ -1360,7 +1339,6 @@ This inherits from Text mode.")
The hook for `text-mode' is run before this one."
:group 'rst
:type '(hook))
-(rst-testcover-defcustom)
;; Pull in variable definitions silencing byte-compiler.
(require 'newcomment)
@@ -1557,7 +1535,6 @@ file."
(const :tag "Underline only" simple))
(integer :tag "Indentation for overline and underline type"
:value 0))))
-(rst-testcover-defcustom)
;; FIXME: Rename this to `rst-over-and-under-default-indent' and set default to
;; 0 because the effect of 1 is probably surprising in the few cases
@@ -1574,7 +1551,6 @@ found in the buffer are to be used but the indentation for
over-and-under adornments is inconsistent across the buffer."
:group 'rst-adjust
:type '(integer))
-(rst-testcover-defcustom)
(defun rst-new-preferred-hdr (seen prev)
;; testcover: ok.
@@ -2013,7 +1989,6 @@ b. a negative numerical argument, which generally inverts
the
:group 'rst-adjust
:type '(hook)
:package-version '(rst . "1.1.0"))
-(rst-testcover-defcustom)
(defcustom rst-new-adornment-down nil
"Controls level of new adornment for section headers."
@@ -2022,7 +1997,6 @@ b. a negative numerical argument, which generally inverts
the
(const :tag "Same level as previous one" nil)
(const :tag "One level down relative to the previous one" t))
:package-version '(rst . "1.1.0"))
-(rst-testcover-defcustom)
(defun rst-adjust-adornment (pfxarg)
"Call `rst-adjust-section' interactively.
@@ -2445,7 +2419,6 @@ also arranged by `rst-insert-list-new-tag'."
:tag (char-to-string char) char))
rst-bullets)))
:package-version '(rst . "1.1.0"))
-(rst-testcover-defcustom)
(defun rst-insert-list-continue (ind tag tab prefer-roman)
;; testcover: ok.
@@ -2682,7 +2655,6 @@ section headers at all."
Also used for formatting insertion, when numbering is disabled."
:type 'integer
:group 'rst-toc)
-(rst-testcover-defcustom)
(defcustom rst-toc-insert-style 'fixed
"Insertion style for table-of-contents.
@@ -2697,19 +2669,16 @@ indentation style:
(const aligned)
(const listed))
:group 'rst-toc)
-(rst-testcover-defcustom)
(defcustom rst-toc-insert-number-separator " "
"Separator that goes between the TOC number and the title."
:type 'string
:group 'rst-toc)
-(rst-testcover-defcustom)
(defcustom rst-toc-insert-max-level nil
"If non-nil, maximum depth of the inserted TOC."
:type '(choice (const nil) integer)
:group 'rst-toc)
-(rst-testcover-defcustom)
(defconst rst-toc-link-keymap
(let ((map (make-sparse-keymap)))
@@ -3174,35 +3143,30 @@ These indentation widths can be customized here."
"Indentation when there is no more indentation point given."
:group 'rst-indent
:type '(integer))
-(rst-testcover-defcustom)
(defcustom rst-indent-field 3
"Indentation for first line after a field or 0 to always indent for content."
:group 'rst-indent
:package-version '(rst . "1.1.0")
:type '(integer))
-(rst-testcover-defcustom)
(defcustom rst-indent-literal-normal 3
"Default indentation for literal block after a markup on an own line."
:group 'rst-indent
:package-version '(rst . "1.1.0")
:type '(integer))
-(rst-testcover-defcustom)
(defcustom rst-indent-literal-minimized 2
"Default indentation for literal block after a minimized markup."
:group 'rst-indent
:package-version '(rst . "1.1.0")
:type '(integer))
-(rst-testcover-defcustom)
(defcustom rst-indent-comment 3
"Default indentation for first line of a comment."
:group 'rst-indent
:package-version '(rst . "1.1.0")
:type '(integer))
-(rst-testcover-defcustom)
;; FIXME: Must consider other tabs:
;; * Line blocks
@@ -3652,7 +3616,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-block-face
"customize the face `rst-block' instead."
"24.1")
@@ -3667,7 +3630,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-external-face
"customize the face `rst-external' instead."
"24.1")
@@ -3682,7 +3644,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-definition-face
"customize the face `rst-definition' instead."
"24.1")
@@ -3699,7 +3660,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
"Directives and roles."
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-directive-face
"customize the face `rst-directive' instead."
"24.1")
@@ -3714,7 +3674,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-comment-face
"customize the face `rst-comment' instead."
"24.1")
@@ -3729,7 +3688,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-emphasis1-face
"customize the face `rst-emphasis1' instead."
"24.1")
@@ -3743,7 +3701,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
"Double emphasis."
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-emphasis2-face
"customize the face `rst-emphasis2' instead."
"24.1")
@@ -3758,7 +3715,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-literal-face
"customize the face `rst-literal' instead."
"24.1")
@@ -3773,7 +3729,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty
lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-reference-face
"customize the face `rst-reference' instead."
"24.1")
@@ -3856,7 +3811,6 @@ of your own."
(const :tag "transitions" t)
(const :tag "section title adornment" nil))
:value-type (face)))
-(rst-testcover-defcustom)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -4353,7 +4307,6 @@ string)) to be used for converting the document."
(string :tag "Options"))))
:group 'rst-compile
:package-version "1.2.0")
-(rst-testcover-defcustom)
;; FIXME: Must be defcustom.
(defvar rst-compile-primary-toolset 'html
diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el
b/test/lisp/emacs-lisp/testcover-resources/testcases.el
index edb539f..d8b8192 100644
--- a/test/lisp/emacs-lisp/testcover-resources/testcases.el
+++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el
@@ -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,7 +75,6 @@
;; ==== customize-defcustom-bug-25326 ====
"Testcover doesn't prevent testing of defcustom values."
-:expected-result :failed
;; ====
(defgroup testcover-testcase nil
"Test case for testcover"
@@ -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%%%)%%%)
@@ -230,7 +227,6 @@
;; ==== 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))
@@ -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)
@@ -396,9 +388,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 instruments 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
;; ====
(defun testcover-testcase-vec (a b c)
`[,a%%% ,(list b%%% c%%%)%%%]%%%)
@@ -415,7 +414,6 @@
;; ==== vector-in-macro-spec-bug-25316 ====
"Testcover reinstruments within vectors."
-:expected-result :failed
;; ====
(defmacro testcover-testcase-nth-case (arg vec)
(declare (indent 1)
@@ -435,7 +433,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 +447,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 +459,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)%%%)
diff --git a/test/lisp/emacs-lisp/testcover-tests.el
b/test/lisp/emacs-lisp/testcover-tests.el
index 0f0ee9a..2e03488 100644
--- a/test/lisp/emacs-lisp/testcover-tests.el
+++ b/test/lisp/emacs-lisp/testcover-tests.el
@@ -124,14 +124,12 @@ arguments for `testcover-start'."
(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)
+ ;; which can happen if Testcover fails to attach itself
+ ;; correctly. Note that this will prevent debugging
+ ;; these tests using Edebug.
+ (cl-letf (((symbol-function #'edebug-default-enter)
(lambda (&rest _args)
- (ert-fail
- (concat "Debugger invoked during test run "
- "(possible edebug-enter not replaced)")))))
+ (ert-fail "Debugger invoked during test run"))))
(dolist (byte-compile '(t nil))
(testcover-tests-unmarkup-region (point-min) (point-max))
(unwind-protect