diff options
| -rw-r--r-- | modules/coverage-core.el | 53 | ||||
| -rw-r--r-- | tests/test-coverage-core--backend-registry.el | 109 |
2 files changed, 162 insertions, 0 deletions
diff --git a/modules/coverage-core.el b/modules/coverage-core.el index e7540434..f1e8ae88 100644 --- a/modules/coverage-core.el +++ b/modules/coverage-core.el @@ -12,6 +12,59 @@ ;;; Code: +(require 'seq) + +(defvar cj/coverage-backends nil + "Registry of coverage backends in priority order. +Each entry is a plist with at least :name, :detect, :run, and :lcov-path. +Use `cj/coverage-register-backend' to add or replace an entry.") + +(defvar-local cj/coverage-backend nil + "Override: name of the coverage backend to use for the current project. +When nil (the default), resolution runs each registered backend's :detect +function in registration order. Typically set buffer-locally via +`.dir-locals.el' to pin a specific backend.") + +(defun cj/coverage-register-backend (backend) + "Register BACKEND, a plist with :name, :detect, :run, :lcov-path. +Appends to `cj/coverage-backends' at the end, or replaces the existing +entry with the same :name in its current position." + (let ((name (plist-get backend :name))) + (if (cj/--coverage-backend-by-name name) + (setq cj/coverage-backends + (mapcar (lambda (b) + (if (eq (plist-get b :name) name) backend b)) + cj/coverage-backends)) + (setq cj/coverage-backends + (append cj/coverage-backends (list backend)))))) + +(defun cj/--coverage-backend-by-name (name) + "Return the registered backend whose :name equals NAME, or nil." + (seq-find (lambda (b) (eq name (plist-get b :name))) + cj/coverage-backends)) + +(defun cj/--coverage-backend-for-project (root &optional override) + "Resolve the coverage backend to use for ROOT. +OVERRIDE, if non-nil, is a backend name symbol (typically the value of +`cj/coverage-backend' from .dir-locals.el). When given, the named +backend is returned regardless of any :detect functions. Signals +`user-error' when OVERRIDE names a backend that isn't registered. + +When OVERRIDE is nil, each backend's :detect is called in turn with +ROOT as its sole argument; the first that returns non-nil wins. +Returns the backend plist, or nil when no backend matches." + (cond + (override + (or (cj/--coverage-backend-by-name override) + (user-error + "Unknown coverage backend: %s (registered: %s)" + override + (mapcar (lambda (b) (plist-get b :name)) cj/coverage-backends)))) + (t + (seq-find (lambda (backend) + (funcall (plist-get backend :detect) root)) + cj/coverage-backends)))) + (defun cj/--coverage-parse-lcov (file) "Parse FILE as LCOV and return a hash table of covered lines. Keys are source-file paths (strings). Values are hash tables whose diff --git a/tests/test-coverage-core--backend-registry.el b/tests/test-coverage-core--backend-registry.el new file mode 100644 index 00000000..ac1f6f7d --- /dev/null +++ b/tests/test-coverage-core--backend-registry.el @@ -0,0 +1,109 @@ +;;; test-coverage-core--backend-registry.el --- Tests for coverage backend registry -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for the backend registry. +;; +;; A backend is a plist with at least :name, :detect, :run, and :lcov-path +;; keys. `cj/coverage-register-backend' adds or replaces an entry. +;; `cj/--coverage-backend-for-project' resolves which backend applies to +;; a project root, honoring an optional override (buffer-local +;; `cj/coverage-backend' from .dir-locals.el in real use). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'coverage-core) + +(defmacro test-coverage-registry-with-empty (&rest body) + "Run BODY with `cj/coverage-backends' rebound to an empty list." + (declare (indent 0)) + `(let ((cj/coverage-backends nil)) + ,@body)) + +;;; Normal cases + +(ert-deftest test-coverage-backend-register-adds-entry () + "Normal: registering a backend makes it retrievable by name." + (test-coverage-registry-with-empty + (cj/coverage-register-backend + '(:name elisp :detect (lambda (_) t) :run ignore :lcov-path ignore)) + (should (= 1 (length cj/coverage-backends))) + (should (eq 'elisp (plist-get (car cj/coverage-backends) :name))))) + +(ert-deftest test-coverage-backend-register-replaces-in-place () + "Normal: re-registering by name replaces the existing entry at the same position." + (test-coverage-registry-with-empty + (cj/coverage-register-backend + '(:name elisp :detect (lambda (_) nil) :run ignore :lcov-path ignore)) + (cj/coverage-register-backend + '(:name python :detect (lambda (_) nil) :run ignore :lcov-path ignore)) + (cj/coverage-register-backend + '(:name elisp :detect (lambda (_) t) :run ignore :lcov-path ignore)) + (should (= 2 (length cj/coverage-backends))) + (should (eq 'elisp (plist-get (nth 0 cj/coverage-backends) :name))) + (should (eq 'python (plist-get (nth 1 cj/coverage-backends) :name))) + (should (funcall (plist-get (nth 0 cj/coverage-backends) :detect) "/tmp")))) + +(ert-deftest test-coverage-backend-for-project-first-detect-wins () + "Normal: resolution returns the first backend whose :detect matches." + (test-coverage-registry-with-empty + (cj/coverage-register-backend + '(:name a :detect (lambda (_) nil) :run ignore :lcov-path ignore)) + (cj/coverage-register-backend + '(:name b :detect (lambda (_) t) :run ignore :lcov-path ignore)) + (cj/coverage-register-backend + '(:name c :detect (lambda (_) t) :run ignore :lcov-path ignore)) + (let ((backend (cj/--coverage-backend-for-project "/tmp"))) + (should (eq 'b (plist-get backend :name)))))) + +;;; Boundary cases + +(ert-deftest test-coverage-backend-for-project-empty-registry () + "Boundary: empty registry returns nil, not an error." + (test-coverage-registry-with-empty + (should (null (cj/--coverage-backend-for-project "/tmp"))))) + +(ert-deftest test-coverage-backend-for-project-no-match () + "Boundary: no backend's :detect matches returns nil." + (test-coverage-registry-with-empty + (cj/coverage-register-backend + '(:name a :detect (lambda (_) nil) :run ignore :lcov-path ignore)) + (cj/coverage-register-backend + '(:name b :detect (lambda (_) nil) :run ignore :lcov-path ignore)) + (should (null (cj/--coverage-backend-for-project "/tmp"))))) + +(ert-deftest test-coverage-backend-for-project-override-bypasses-detect () + "Boundary: OVERRIDE returns the named backend without calling :detect." + (test-coverage-registry-with-empty + (cj/coverage-register-backend + '(:name a :detect (lambda (_) nil) :run ignore :lcov-path ignore)) + (cj/coverage-register-backend + '(:name b :detect (lambda (_) nil) :run ignore :lcov-path ignore)) + (let ((backend (cj/--coverage-backend-for-project "/tmp" 'b))) + (should (eq 'b (plist-get backend :name)))))) + +(ert-deftest test-coverage-backend-for-project-detect-receives-root () + "Boundary: the :detect function is called with the project root." + (test-coverage-registry-with-empty + (let ((captured nil)) + (cj/coverage-register-backend + `(:name a + :detect ,(lambda (root) (setq captured root) t) + :run ignore :lcov-path ignore)) + (cj/--coverage-backend-for-project "/my/root") + (should (equal "/my/root" captured))))) + +;;; Error cases + +(ert-deftest test-coverage-backend-for-project-override-unknown-errors () + "Error: OVERRIDE that names an unregistered backend signals user-error." + (test-coverage-registry-with-empty + (cj/coverage-register-backend + '(:name a :detect (lambda (_) t) :run ignore :lcov-path ignore)) + (should-error (cj/--coverage-backend-for-project "/tmp" 'bogus) + :type 'user-error))) + +(provide 'test-coverage-core--backend-registry) +;;; test-coverage-core--backend-registry.el ends here |