[elpa] master c8fa33f 170/271: Improve async benchmarking.

[Jackson Ray Hamilton]

branch: master
commit c8fa33fbd89dff6203e232bbf962dba5dbc18376
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

    Improve async benchmarking.
---
 benchmark/context-coloring-benchmark.el |  111 +++++++++++++++++++++----------
 1 files changed, 76 insertions(+), 35 deletions(-)

diff --git a/benchmark/context-coloring-benchmark.el 
b/benchmark/context-coloring-benchmark.el
index be03229..707188f 100644
--- a/benchmark/context-coloring-benchmark.el
+++ b/benchmark/context-coloring-benchmark.el
@@ -1,3 +1,5 @@
+;; -*- lexical-binding: t; -*-
+
 (defconst context-coloring-benchmark-path
   (file-name-directory (or load-file-name buffer-file-name)))
 
@@ -15,6 +17,59 @@
       (append-to-buffer results-buffer (point-min) (point-max))))
   (append-to-file nil nil result-file))
 
+(defun context-coloring-benchmark-next-tick (function)
+  (run-at-time 0.001 nil function))
+
+(defun context-coloring-benchmark-next (list continue stop)
+  (if (null list)
+      (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)
+  (funcall setup)
+  (let ((result-file (context-coloring-benchmark-resolve-path
+                      (concat "./results-" title "-" (format-time-string "%s") 
".log"))))
+    (context-coloring-benchmark-next
+     fixtures
+     (lambda (path next)
+       (let ((fixture (context-coloring-benchmark-resolve-path path))
+             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)
+         (find-file fixture)))
+     (lambda ()
+       (funcall teardown)
+       (if callback (funcall callback))))))
+
+(defconst context-coloring-benchmark-js-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"))
+
 (defun context-coloring-benchmark-js-mode-setup ()
   (add-hook 'js-mode-hook 'context-coloring-mode)
   (elp-instrument-package "context-coloring-"))
@@ -22,23 +77,13 @@
 (defun context-coloring-benchmark-js-mode-teardown ()
   (remove-hook 'js-mode-hook 'context-coloring-mode))
 
-(defun context-coloring-benchmark-js-mode-run ()
-  (context-coloring-benchmark-js-mode-setup)
-  (let ((result-file (context-coloring-benchmark-resolve-path
-                      (concat "./results-js-mode-" (format-time-string "%s") 
".log"))))
-    (dolist (path '("./fixtures/jquery-2.1.1.js"
-                    "./fixtures/lodash-2.4.1.js"
-                    "./fixtures/async-0.9.0.js"
-                    "./fixtures/mkdirp-0.5.0.js"))
-      (let ((fixture (context-coloring-benchmark-resolve-path path)))
-        ;; Test 5 times.
-        (find-file fixture)
-        (dotimes (n 4)
-          (sit-for 1)
-          (revert-buffer t t))
-        (sit-for 1)
-        (context-coloring-benchmark-log-results result-file fixture))))
-  (context-coloring-benchmark-js-mode-teardown))
+(defun context-coloring-benchmark-js-mode-run (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 ()
   (require 'js2-mode)
@@ -55,23 +100,19 @@
   (setq js2-mode-show-strict-warnings t)
   (setq js2-mode-show-parse-errors t))
 
-(defun context-coloring-benchmark-js2-mode-run ()
-  (context-coloring-benchmark-js2-mode-setup)
-  (let ((result-file (context-coloring-benchmark-resolve-path
-                      (concat "./results-js2-mode-" (format-time-string "%s") 
".log"))))
-    (dolist (path '("./fixtures/jquery-2.1.1.js"
-                    "./fixtures/lodash-2.4.1.js"
-                    "./fixtures/async-0.9.0.js"
-                    "./fixtures/mkdirp-0.5.0.js"))
-      (let ((fixture (context-coloring-benchmark-resolve-path path)))
-        ;; Test 5 times.
-        (find-file fixture)
-        (dotimes (n 4)
-          (revert-buffer t t))
-        (context-coloring-benchmark-log-results result-file fixture))))
-  (context-coloring-benchmark-js2-mode-teardown))
+(defun context-coloring-benchmark-js2-mode-run (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))
 
 (defun context-coloring-benchmark-run ()
-  ;; (context-coloring-benchmark-js-mode-run)
-  (context-coloring-benchmark-js2-mode-run)
-  (kill-emacs))
+  (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))))