X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/54df2598550c8040def7aec80d04847458d990df..9319a954d1298358bf5a1ea6d53da1905916a1e6:/packages/context-coloring/benchmark/context-coloring-benchmark.el diff --git a/packages/context-coloring/benchmark/context-coloring-benchmark.el b/packages/context-coloring/benchmark/context-coloring-benchmark.el index 2de5646aa..c627249b3 100644 --- a/packages/context-coloring/benchmark/context-coloring-benchmark.el +++ b/packages/context-coloring/benchmark/context-coloring-benchmark.el @@ -1,4 +1,4 @@ -;;; benchmark/context-coloring-benchmark.el --- Benchmarks for context coloring. -*- lexical-binding: t; -*- +;;; context-coloring-benchmark.el --- Benchmarks for context coloring -*- lexical-binding: t; -*- ;; Copyright (C) 2014-2015 Free Software Foundation, Inc. @@ -19,16 +19,14 @@ ;;; Commentary: -;; Benchmarks for context-coloring. +;; Benchmarks for context coloring. -;; `ert' instruments and benchmarks the package's functions, and the results are -;; logged to `benchmark/logs'. - -;; To run, execute `make bench' from the project root. +;; Use with `make bench'. ;;; Code: (require 'context-coloring) +(require 'elp) (require 'js2-mode) @@ -40,134 +38,126 @@ "Resolve PATH from this file's directory." (expand-file-name path context-coloring-benchmark-path)) -(defun context-coloring-benchmark-log-results (result-file fixture) - "Log benchmarking results to RESULT-FILE for fixture FIXTURE." - (elp-results) - (let ((results-buffer (current-buffer))) - (with-temp-buffer - (insert (concat fixture "\n")) - (prepend-to-buffer results-buffer (point-min) (point-max))) - (with-temp-buffer - (insert "\n") - (append-to-buffer results-buffer (point-min) (point-max)))) - (make-directory (context-coloring-benchmark-resolve-path "./logs") t) - (append-to-file nil nil result-file)) - -(defun context-coloring-benchmark-next-tick (function) - "Defer execution of FUNCTION to clear the stack and to ensure -asynchrony." - (run-at-time 0.001 nil function)) - -(defun context-coloring-benchmark-next (list continue stop) - "Run the next test in LIST by calling CONTINUE. When LIST is -exhausted, call STOP instead." - (if (null list) - (progn - (context-coloring-benchmark-next-tick stop)) - (context-coloring-benchmark-next-tick - (lambda () - (funcall - continue - (car list) - (lambda () - (context-coloring-benchmark-next (cdr list) continue stop))))))) - -(defun context-coloring-benchmark-async (title setup teardown fixtures callback) - "Execute a benchmark titled TITLE with SETUP and TEARDOWN -callbacks. Measure the performance of all FIXTURES, calling -CALLBACK when all are done." - (funcall setup) +(defun context-coloring-benchmark-log-results (result-file fixture statistics) + "Log results to RESULT-FILE for FIXTURE with STATISTICS." + (let ((results (prog1 + (progn + (elp-results) + (buffer-substring-no-properties (point-min) (point-max))) + (kill-buffer)))) + (make-directory (context-coloring-benchmark-resolve-path "./logs") t) + (append-to-file + (with-temp-buffer + (goto-char (point-min)) + (insert (format "For fixture \"%s\":\n" fixture)) + (insert "\n") + (insert "General statistics:\n") + (insert (format "File size: %s bytes\n" (plist-get statistics :file-size))) + (insert (format "Lines: %s\n" (plist-get statistics :lines))) + (insert (format "Words: %s\n" (plist-get statistics :words))) + (insert (format "Colorization times: %s\n" + (context-coloring-join + (mapcar (lambda (number) + (format "%.4f" number)) + (plist-get statistics :colorization-times)) ", "))) + (insert (format "Average colorization time: %.4f\n" + (plist-get statistics :average-colorization-time))) + (insert "\n") + (insert "Function statistics:\n") + (insert "(Function Name / Call Count / Elapsed Time / Average Time):\n") + (insert results) + (insert "\n") + (buffer-substring-no-properties (point-min) (point-max))) + nil result-file))) + +(defun context-coloring-benchmark (title fixtures) + "Execute a benchmark titled TITLE against FIXTURES." (let ((result-file (context-coloring-benchmark-resolve-path (format "./logs/results-%s-%s.log" title (format-time-string "%s"))))) - (context-coloring-benchmark-next - fixtures - (lambda (path next) + (mapc + (lambda (path) (let ((fixture (context-coloring-benchmark-resolve-path path)) + colorization-start-time + (colorization-times '()) advice) (setq advice (let ((count 0)) (lambda (original-function) - (funcall - original-function - (lambda () - (setq count (+ count 1)) - ;; Test 5 times. - (if (= count 5) - (progn - (advice-remove 'context-coloring-colorize advice) - (kill-buffer) - (context-coloring-benchmark-log-results - result-file - fixture) - (funcall next)) - (funcall 'context-coloring-colorize))))))) - (advice-add 'context-coloring-colorize :around advice) + (funcall original-function) + (setq count (+ count 1)) + ;; First 5 runs are for gathering real coloring times, + ;; unaffected by elp instrumentation. + (when (<= count 5) + (push (- (float-time) colorization-start-time) colorization-times)) + (cond + ((= count 10) + (advice-remove #'context-coloring-colorize advice) + (context-coloring-benchmark-log-results + result-file + fixture + (list + :file-size (nth 7 (file-attributes fixture)) + :lines (count-lines (point-min) (point-max)) + :words (count-words (point-min) (point-max)) + :colorization-times colorization-times + :average-colorization-time (/ (apply #'+ colorization-times) 5))) + (elp-restore-all) + (kill-buffer)) + ;; The last 5 runs are for gathering function call and + ;; duration statistics. + ((= count 5) + (elp-instrument-package "context-coloring-") + (context-coloring-colorize)) + (t + (setq colorization-start-time (float-time)) + (context-coloring-colorize)))))) + (advice-add #'context-coloring-colorize :around advice) + (setq colorization-start-time (float-time)) (find-file fixture))) - (lambda () - (funcall teardown) - (when callback (funcall callback)))))) + fixtures))) -(defconst context-coloring-benchmark-js-fixtures +(defconst context-coloring-benchmark-javascript-fixtures '("./fixtures/jquery-2.1.1.js" "./fixtures/lodash-2.4.1.js" "./fixtures/async-0.9.0.js" "./fixtures/mkdirp-0.5.0.js") "Arbitrary JavaScript files for performance scrutiny.") -(defun context-coloring-benchmark-js-mode-setup () - "Preparation logic for `js-mode'." - (add-hook 'js-mode-hook 'context-coloring-mode) - (elp-instrument-package "context-coloring-")) - -(defun context-coloring-benchmark-js-mode-teardown () - "Cleanup logic for `js-mode'." - (remove-hook 'js-mode-hook 'context-coloring-mode)) - -(defun context-coloring-benchmark-js-mode-run (callback) - "Benchmark `js-mode', then call CALLBACK." - (context-coloring-benchmark-async - "js-mode" - 'context-coloring-benchmark-js-mode-setup - 'context-coloring-benchmark-js-mode-teardown - context-coloring-benchmark-js-fixtures - callback)) - -(defun context-coloring-benchmark-js2-mode-setup () - "Preparation logic for `js2-mode'." - (setq js2-mode-show-parse-errors nil) - (setq js2-mode-show-strict-warnings nil) +(defun context-coloring-benchmark-js2-mode-run () + "Benchmark `js2-mode'." (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode)) - (add-hook 'js2-mode-hook 'context-coloring-mode) - (elp-instrument-package "context-coloring-")) - -(defun context-coloring-benchmark-js2-mode-teardown () - "Cleanup logic for `js2-mode'." - (remove-hook 'js2-mode-hook 'context-coloring-mode) + (add-hook 'js2-mode-hook #'context-coloring-mode) + (let ((js2-mode-show-parse-errors nil) + (js2-mode-show-strict-warnings nil)) + (context-coloring-benchmark + "js2-mode" + context-coloring-benchmark-javascript-fixtures)) (setq auto-mode-alist (delete '("\\.js\\'" . js2-mode) auto-mode-alist)) - (setq js2-mode-show-strict-warnings t) - (setq js2-mode-show-parse-errors t)) - -(defun context-coloring-benchmark-js2-mode-run (callback) - "Benchmark `js2-mode', then call CALLBACK." - (context-coloring-benchmark-async - "js2-mode" - 'context-coloring-benchmark-js2-mode-setup - 'context-coloring-benchmark-js2-mode-teardown - context-coloring-benchmark-js-fixtures - callback)) + (remove-hook 'js2-mode-hook #'context-coloring-mode)) + +(defconst context-coloring-benchmark-emacs-lisp-fixtures + '("./fixtures/lisp.el" + "./fixtures/faces.el" + "./fixtures/subr.el" + "./fixtures/simple.el") + "Arbitrary Emacs Lisp files for performance scrutiny.") + +(defun context-coloring-benchmark-emacs-lisp-mode-run () + "Benchmark `emacs-lisp-mode', then call CALLBACK." + (add-hook 'emacs-lisp-mode-hook #'context-coloring-mode) + (context-coloring-benchmark + "emacs-lisp-mode" + context-coloring-benchmark-emacs-lisp-fixtures) + (remove-hook 'emacs-lisp-mode-hook #'context-coloring-mode)) (defun context-coloring-benchmark-run () "Benchmark all modes, then exit." - (context-coloring-benchmark-next - '(context-coloring-benchmark-js-mode-run - context-coloring-benchmark-js2-mode-run) - (lambda (function next) - (funcall function next)) - (lambda () - (kill-emacs)))) + (context-coloring-benchmark-js2-mode-run) + (context-coloring-benchmark-emacs-lisp-mode-run) + (kill-emacs)) (provide 'context-coloring-benchmark)