Function: testcover-analyze-coverage

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

Signature

(testcover-analyze-coverage FORM)

Documentation

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.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/testcover.el.gz
;;; 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 `edebug-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)
     'testcover-1value)

    (`(defun ,name ,_ . ,doc-and-body)
     (let ((val (testcover-analyze-coverage-progn doc-and-body)))
       (cl-case val
         ((testcover-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.
     'testcover-1value)

    (`(,'\` ,bq-form)
     (testcover-analyze-coverage-backquote-form bq-form))

    ((or 't 'nil (pred keywordp))
     'testcover-1value)

    ((pred vectorp)
     (testcover-analyze-coverage-compose (append form nil)
                                         #'testcover-analyze-coverage))

    ((pred symbolp)
     nil)

    ((pred atom)
     'testcover-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))))