Function: testcover-mark

testcover-mark is a byte-compiled function defined in testcover.el.gz.

Signature

(testcover-mark DEF)

Documentation

Mark one DEF (a function or macro symbol) to highlight its contained forms that did not get completely tested during coverage tests.
  A marking with the face testcover-nohits (default = red) indicates that the
form was never evaluated. A marking using the testcover-1value face
(default = tan) indicates that the form always evaluated to the same value.
  The forms throw, error, and signal are not marked. They do not return and
would always get a red mark. Some forms that always return the same value (e.g., setq of a constant), always get a tan mark that can't be eliminated by adding more test cases.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/testcover.el.gz
;;;=========================================================================
;;; Display the coverage data as color splotches on your code.
;;;=========================================================================

(defun testcover-mark (def)
  "Mark one DEF (a function or macro symbol) to highlight its contained forms
that did not get completely tested during coverage tests.
  A marking with the face `testcover-nohits' (default = red) indicates that the
form was never evaluated.  A marking using the `testcover-1value' face
\(default = tan) indicates that the form always evaluated to the same value.
  The forms throw, error, and signal are not marked.  They do not return and
would always get a red mark.  Some forms that always return the same
value (e.g., setq of a constant), always get a tan mark that can't be
eliminated by adding more test cases."
  (let* ((data     (get def 'edebug))
	 (def-mark (car data))
	 (points   (nth 2 data))
	 (len      (length points))
	 (changed (buffer-modified-p))
	 (coverage (get def 'edebug-coverage))
	 ov j)
    (or (and def-mark points coverage)
	(error "Missing edebug data for function %s" def))
    (when (> len 0)
      (set-buffer (marker-buffer def-mark))
      (mapc 'delete-overlay
	    (overlays-in def-mark (+ def-mark (aref points (1- len)) 1)))
      (while (> len 0)
	(setq len  (1- len)
	      data (aref coverage len))
        (when (and (not (eq data 'edebug-ok-coverage))
                   (not (memq (car-safe data)
                              '(testcover-1value maybe noreturn)))
                   (setq j (+ def-mark (aref points len))))
	  (setq ov (make-overlay (1- j) j))
	  (overlay-put ov 'face
                       (if (memq data '(edebug-unknown maybe testcover-1value))
			   'testcover-nohits
			 'testcover-1value))))
      (set-buffer-modified-p changed))))