1 ;;; benchmark/context-coloring-benchmark.el --- Benchmarks 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 ;; Benchmarks for context-coloring.
24 ;; `ert' instruments and benchmarks the package's functions, and the results are
25 ;; logged to `benchmark/logs'.
27 ;; To run, execute `make bench' from the project root.
31 (require 'context-coloring)
35 (defconst context-coloring-benchmark-path
36 (file-name-directory (or load-file-name buffer-file-name))
37 "This file's directory.")
39 (defun context-coloring-benchmark-resolve-path (path)
40 "Resolve PATH from this file's directory."
41 (expand-file-name path context-coloring-benchmark-path))
43 (defun context-coloring-benchmark-log-results (result-file fixture)
44 "Log benchmarking results to RESULT-FILE for fixture FIXTURE."
46 (let ((results-buffer (current-buffer)))
48 (insert (concat fixture "\n"))
49 (prepend-to-buffer results-buffer (point-min) (point-max)))
52 (append-to-buffer results-buffer (point-min) (point-max))))
53 (make-directory (context-coloring-benchmark-resolve-path "./logs") t)
54 (append-to-file nil nil result-file))
56 (defun context-coloring-benchmark-next-tick (function)
57 "Defer execution of FUNCTION to clear the stack and to ensure
59 (run-at-time 0.001 nil function))
61 (defun context-coloring-benchmark-next (list continue stop)
62 "Run the next test in LIST by calling CONTINUE. When LIST is
63 exhausted, call STOP instead."
66 (context-coloring-benchmark-next-tick stop))
67 (context-coloring-benchmark-next-tick
73 (context-coloring-benchmark-next (cdr list) continue stop)))))))
75 (defun context-coloring-benchmark-async (title setup teardown fixtures callback)
76 "Execute a benchmark titled TITLE with SETUP and TEARDOWN
77 callbacks. Measure the performance of all FIXTURES, calling
78 CALLBACK when all are done."
80 (let ((result-file (context-coloring-benchmark-resolve-path
81 (format "./logs/results-%s-%s.log"
82 title (format-time-string "%s")))))
83 (context-coloring-benchmark-next
86 (let ((fixture (context-coloring-benchmark-resolve-path path))
91 (lambda (original-function)
95 (setq count (+ count 1))
99 (advice-remove 'context-coloring-colorize advice)
101 (context-coloring-benchmark-log-results
105 (funcall 'context-coloring-colorize)))))))
106 (advice-add 'context-coloring-colorize :around advice)
107 (find-file fixture)))
110 (when callback (funcall callback))))))
112 (defconst context-coloring-benchmark-js-fixtures
113 '("./fixtures/jquery-2.1.1.js"
114 "./fixtures/lodash-2.4.1.js"
115 "./fixtures/async-0.9.0.js"
116 "./fixtures/mkdirp-0.5.0.js")
117 "Arbitrary JavaScript files for performance scrutiny.")
119 (defun context-coloring-benchmark-js-mode-setup ()
120 "Preparation logic for `js-mode'."
121 (add-hook 'js-mode-hook 'context-coloring-mode)
122 (elp-instrument-package "context-coloring-"))
124 (defun context-coloring-benchmark-js-mode-teardown ()
125 "Cleanup logic for `js-mode'."
126 (remove-hook 'js-mode-hook 'context-coloring-mode))
128 (defun context-coloring-benchmark-js-mode-run (callback)
129 "Benchmark `js-mode', then call CALLBACK."
130 (context-coloring-benchmark-async
132 'context-coloring-benchmark-js-mode-setup
133 'context-coloring-benchmark-js-mode-teardown
134 context-coloring-benchmark-js-fixtures
137 (defun context-coloring-benchmark-js2-mode-setup ()
138 "Preparation logic for `js2-mode'."
139 (setq js2-mode-show-parse-errors nil)
140 (setq js2-mode-show-strict-warnings nil)
141 (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
142 (add-hook 'js2-mode-hook 'context-coloring-mode)
143 (elp-instrument-package "context-coloring-"))
145 (defun context-coloring-benchmark-js2-mode-teardown ()
146 "Cleanup logic for `js2-mode'."
147 (remove-hook 'js2-mode-hook 'context-coloring-mode)
148 (setq auto-mode-alist (delete '("\\.js\\'" . js2-mode)
150 (setq js2-mode-show-strict-warnings t)
151 (setq js2-mode-show-parse-errors t))
153 (defun context-coloring-benchmark-js2-mode-run (callback)
154 "Benchmark `js2-mode', then call CALLBACK."
155 (context-coloring-benchmark-async
157 'context-coloring-benchmark-js2-mode-setup
158 'context-coloring-benchmark-js2-mode-teardown
159 context-coloring-benchmark-js-fixtures
162 (defun context-coloring-benchmark-run ()
163 "Benchmark all modes, then exit."
164 (context-coloring-benchmark-next
165 '(context-coloring-benchmark-js-mode-run
166 context-coloring-benchmark-js2-mode-run)
167 (lambda (function next)
168 (funcall function next))
172 (provide 'context-coloring-benchmark)
174 ;;; context-coloring-benchmark.el ends here