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