code.delx.au - gnu-emacs-elpa/blob - benchmark/context-coloring-benchmark.el

   1 ;; -*- lexical-binding: t; -*-
   2
   3 (defconst context-coloring-benchmark-path
   4   (file-name-directory (or load-file-name buffer-file-name)))
   5
   6 (defun context-coloring-benchmark-resolve-path (path)
   7   (expand-file-name path context-coloring-benchmark-path))
   8
   9 (defun context-coloring-benchmark-log-results (result-file fixture)
  10   (elp-results)
  11   (let ((results-buffer (current-buffer)))
  12     (with-temp-buffer
  13       (insert (concat fixture "\n"))
  14       (prepend-to-buffer results-buffer (point-min) (point-max)))
  15     (with-temp-buffer
  16       (insert "\n")
  17       (append-to-buffer results-buffer (point-min) (point-max))))
  18   (make-directory (context-coloring-benchmark-resolve-path "./logs") t)
  19   (append-to-file nil nil result-file))
  20
  21 (defun context-coloring-benchmark-next-tick (function)
  22   (run-at-time 0.001 nil function))
  23
  24 (defun context-coloring-benchmark-next (list continue stop)
  25   (if (null list)
  26       (context-coloring-benchmark-next-tick stop)
  27     (context-coloring-benchmark-next-tick
  28      (lambda ()
  29        (funcall
  30         continue
  31         (car list)
  32         (lambda ()
  33           (context-coloring-benchmark-next (cdr list) continue stop)))))))
  34
  35 (defun context-coloring-benchmark-async (title setup teardown fixtures callback)
  36   (funcall setup)
  37   (let ((result-file (context-coloring-benchmark-resolve-path
  38                       (concat "./logs/results-" title "-" (format-time-string "%s") ".log"))))
  39     (context-coloring-benchmark-next
  40      fixtures
  41      (lambda (path next)
  42        (let ((fixture (context-coloring-benchmark-resolve-path path))
  43              advice)
  44          (setq
  45           advice
  46           (let ((count 0))
  47             (lambda (original-function)
  48               (funcall
  49                original-function
  50                (lambda ()
  51                  (setq count (+ count 1))
  52                  ;; Test 5 times.
  53                  (if (= count 5)
  54                      (progn
  55                        (advice-remove 'context-coloring-colorize advice)
  56                        (kill-buffer)
  57                        (context-coloring-benchmark-log-results
  58                         result-file
  59                         fixture)
  60                        (funcall next))
  61                    (funcall 'context-coloring-colorize)))))))
  62          (advice-add 'context-coloring-colorize :around advice)
  63          (find-file fixture)))
  64      (lambda ()
  65        (funcall teardown)
  66        (if callback (funcall callback))))))
  67
  68 (defconst context-coloring-benchmark-js-fixtures
  69   '("./fixtures/jquery-2.1.1.js"
  70     "./fixtures/lodash-2.4.1.js"
  71     "./fixtures/async-0.9.0.js"
  72     "./fixtures/mkdirp-0.5.0.js"))
  73
  74 (defun context-coloring-benchmark-js-mode-setup ()
  75   (add-hook 'js-mode-hook 'context-coloring-mode)
  76   (elp-instrument-package "context-coloring-"))
  77
  78 (defun context-coloring-benchmark-js-mode-teardown ()
  79   (remove-hook 'js-mode-hook 'context-coloring-mode))
  80
  81 (defun context-coloring-benchmark-js-mode-run (callback)
  82   (context-coloring-benchmark-async
  83    "js-mode"
  84    'context-coloring-benchmark-js-mode-setup
  85    'context-coloring-benchmark-js-mode-teardown
  86    context-coloring-benchmark-js-fixtures
  87    callback))
  88
  89 (defun context-coloring-benchmark-js2-mode-setup ()
  90   (require 'js2-mode)
  91   (setq js2-mode-show-parse-errors nil)
  92   (setq js2-mode-show-strict-warnings nil)
  93   (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
  94   (add-hook 'js2-mode-hook 'context-coloring-mode)
  95   (elp-instrument-package "context-coloring-"))
  96
  97 (defun context-coloring-benchmark-js2-mode-teardown ()
  98   (remove-hook 'js2-mode-hook 'context-coloring-mode)
  99   (setq auto-mode-alist (delete '("\\.js\\'" . js2-mode)
 100                                 auto-mode-alist))
 101   (setq js2-mode-show-strict-warnings t)
 102   (setq js2-mode-show-parse-errors t))
 103
 104 (defun context-coloring-benchmark-js2-mode-run (callback)
 105   (context-coloring-benchmark-async
 106    "js2-mode"
 107    'context-coloring-benchmark-js2-mode-setup
 108    'context-coloring-benchmark-js2-mode-teardown
 109    context-coloring-benchmark-js-fixtures
 110    callback))
 111
 112 (defun context-coloring-benchmark-run ()
 113   (context-coloring-benchmark-next
 114    '(context-coloring-benchmark-js-mode-run
 115      context-coloring-benchmark-js2-mode-run)
 116    (lambda (function next)
 117      (funcall function next))
 118    (lambda ()
 119      (kill-emacs))))