1 ;;; context-coloring-coverage.el --- Test coverage for context coloring -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22 ;; Test coverage support for context coloring.
24 ;; Use with `make cover'.
32 (defconst context-coloring-coverage-directory
33 (file-name-directory (or load-file-name buffer-file-name))
34 "This file's directory.")
36 (defun context-coloring-coverage-resolve-path (path)
37 "Resolve PATH from this file's directory."
38 (expand-file-name path context-coloring-coverage-directory))
40 (defconst context-coloring-coverage-output-file-prefix
41 (format-time-string "%s"))
43 (defconst context-coloring-coverage-output-directory
44 (context-coloring-coverage-resolve-path "./coverage/"))
46 (defconst context-coloring-coverage-output-file
47 (concat context-coloring-coverage-output-directory
48 context-coloring-coverage-output-file-prefix ".json"))
50 (defconst context-coloring-coverage-report-file
51 (concat context-coloring-coverage-output-directory
52 context-coloring-coverage-output-file-prefix ".txt"))
54 (defun context-coloring-coverage-join (strings delimiter)
55 "Join a list of STRINGS with the string DELIMITER."
56 (mapconcat #'identity strings delimiter))
58 (defun context-coloring-coverage-percentage (dividend divisor)
59 "Get the percentage of DIVIDEND / DIVISOR with precision 2."
60 (let ((percentage (/ (float (round (* (/ (float dividend) divisor) 10000))) 100)))
63 ((= (mod percentage 1) 0)
64 ;; Get an integer because we don't like dangling zeros.
69 (defun context-coloring-coverage-format-source-file (source-file)
70 "Generate a report for SOURCE-FILE's line coverage."
71 (let* ((source-lines (split-string (cdr (assq 'source source-file)) "\n"))
72 (coverage (cdr (assq 'coverage source-file)))
73 (results (list "Hits | Source"
74 (context-coloring-coverage-join (make-vector 80 "-") "")))
80 (setq hits (car coverage))
81 (setq coverage (cdr coverage))
82 (setq source-line (car source-lines))
83 (setq source-lines (cdr source-lines))
84 (when (not (null hits))
85 (setq lines-hittable (+ lines-hittable 1))
87 (setq lines-hit (+ lines-hit 1))))
93 (if (and hits (= hits 0)) "~" "|")
105 (context-coloring-coverage-percentage lines-hit lines-hittable)))))
106 (context-coloring-coverage-join results "\n")))
108 (defun context-coloring-coverage-format (coverage-data)
109 "Generate reports for all files in COVERAGE-DATA."
110 (context-coloring-coverage-join
112 #'context-coloring-coverage-format-source-file
113 (cdr (assq 'source_files coverage-data)))
116 (defun context-coloring-coverage-local-init ()
117 "Initialize test coverage for local viewing."
118 (make-directory context-coloring-coverage-output-directory t)
119 (setq undercover-force-coverage t)
120 (setenv "COVERALLS_REPO_TOKEN" "noop")
121 (undercover "context-coloring.el"
122 (:report-file context-coloring-coverage-output-file)
127 (let (original-json-array-type
131 (insert-file-contents-literally context-coloring-coverage-output-file)
132 (setq original-json-array-type json-array-type)
133 (setq json-array-type 'list)
135 (json-read-from-string
136 (buffer-substring-no-properties (point-min) (point-max))))
137 (setq json-array-type original-json-array-type)
139 (context-coloring-coverage-format coverage-data))
140 (setq report (concat report "\n")))
144 (write-file context-coloring-coverage-report-file))))
146 (require 'context-coloring))
148 (defun context-coloring-coverage-ci-init ()
149 "Initialize test coverage for continuous integration."
150 (undercover "context-coloring.el")
151 (require 'context-coloring))
153 (provide 'context-coloring-coverage)
155 ;;; context-coloring-coverage.el ends here