Split benchmarking code from test code

Author: ubolonton

.github/workflows/main.yml

@@ -89,3 +89,5 @@ jobs:
         run: npm install -g tree-sitter-cli@0.19.3
       - run: bin/test
         if: ${{ !matrix.target }}
+      - run: bin/test bench
+        if: ${{ !matrix.target }}

.github/workflows/release.yml

@@ -78,6 +78,8 @@ jobs:
         run: npm install -g tree-sitter-cli@0.19.3
       - run: bin/test
         if: ${{ !matrix.target }}
+      - run: bin/test bench
+        if: ${{ !matrix.target }}
 
       - name: Rename cross-build's binary
         if: matrix.target

bin/test

@@ -14,6 +14,8 @@ if [[ $* == "watch" ]]; then
 else
     if [[ $* == "integ" ]]; then
         test_mod="tsc-dyn-get-tests.el"
+    elif [[ $* == "bench" ]]; then
+        test_mod="tree-sitter-bench.el"
     else
         test_mod="tree-sitter-tests.el"
     fi

bin/test.ps1

@@ -11,6 +11,8 @@ if ($args[0] -eq "watch") {
 } else {
     if ($args[0] -eq "integ") {
         $test_mod = "tsc-dyn-get-tests.el"
+    } elseif ($args[0] -eq "bench") {
+        $test_mod = "tree-sitter-bench.el"
     } else {
         $test_mod = "tree-sitter-tests.el"
     }

tests/tree-sitter-bench.el

@@ -0,0 +1,94 @@
+;;; tree-sitter-bench.el --- Benchmarks for tree-sitter.el -*- lexical-binding: t; coding: utf-8 -*-
+
+;; Copyright (C) 2019-2022  Tuấn-Anh Nguyễn
+;;
+;; Author: Tuấn-Anh Nguyễn <ubolonton@gmail.com>
+;; SPDX-License-Identifier: MIT
+
+;;; Commentary:
+
+;; Benchmarks for `tree-sitter'.
+
+;;; Code:
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+(require 'tree-sitter-tests-utils)
+
+(ert-deftest parsing::bench ()
+  (tsc-test-with c parser
+    (tsc-test-with-file "data/types.rs"
+      (let ((n 0))
+        (while (<= n 4)
+          (let ((tsc--buffer-input-chunk-size (* 1024 (expt 2 n))))
+            (garbage-collect)
+            (message "tsc-parse-chunks %6d %s" tsc--buffer-input-chunk-size
+                     (benchmark-run 10
+                         (tsc-parse-chunks parser #'tsc--buffer-input nil)))
+            (cl-incf n)))))))
+
+(ert-deftest cursor::bench ()
+  (tsc-test-lang-with-file rust "data/types.rs"
+    (require 'rust-mode)
+    (rust-mode)
+    (tree-sitter-mode)
+    (let ((props [:named-p :type :start-byte :end-byte]))
+      (dolist (n '(1 10 100))
+        (message "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
+        (garbage-collect)
+        (message "%10s %3d %s" :mapc n
+                 (eval `(benchmark-run-compiled ,n
+                          (tsc-traverse-mapc
+                           tsc-test-no-op
+                           tree-sitter-tree
+                           ,props))))
+        (garbage-collect)
+        (message "%10s %3d %s" :iter n
+                 (eval `(benchmark-run-compiled ,n
+                          (iter-do (_ (tsc-traverse-iter tree-sitter-tree ,props))
+                            (tsc-test-no-op)))))
+        (garbage-collect)
+        (message "%10s %3d %s" :do n
+                 (eval `(benchmark-run-compiled ,n
+                          (tsc-traverse-do ([named-p type start-byte end-byte] tree-sitter-tree)
+                            named-p type start-byte end-byte))))
+        (garbage-collect)
+        (message "%10s %3d %s" 'funcall n
+                 (eval `(benchmark-run-compiled ,(* 3429 n)
+                          (funcall tsc-test-no-op ,props 5))))))))
+
+(ert-deftest hl::bench ()
+  (tsc-test-lang-with-file rust "data/types.rs"
+    (setq tree-sitter-hl-default-patterns (tree-sitter-langs--hl-default-patterns 'rust))
+    (require 'rust-mode)
+    (rust-mode)
+    (font-lock-mode)
+    (font-lock-set-defaults)
+    (dolist (n '(1 10 100))
+      (message "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
+      (tree-sitter-hl-mode)
+      (garbage-collect)
+      (message "tree-sitter-hl %2d %s" n (eval `(benchmark-run-compiled ,n (font-lock-ensure))))
+      (tree-sitter-hl-mode -1)
+      (font-lock-ensure)
+      (garbage-collect)
+      (message "     font-lock %2d %s" n (eval `(benchmark-run-compiled ,n (font-lock-ensure)))))))
+
+(ert-deftest debug::bench ()
+  (tsc-test-lang-with-file rust "data/types.rs"
+    (setq tree-sitter-hl-default-patterns (tree-sitter-langs--hl-default-patterns 'rust))
+    (require 'rust-mode)
+    (rust-mode)
+    (dolist (n '(1 10 100))
+      (message "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
+      (dolist (tree-sitter-debug-traversal-method '(:mapc :iter :do))
+        (garbage-collect)
+        (message "%10s %3d %s" tree-sitter-debug-traversal-method n
+                 (eval `(benchmark-run-compiled ,n
+                          (progn (tree-sitter-debug-mode -1)
+                                 (tree-sitter-debug-mode)))))))))
+
+(provide 'tree-sitter-bench)
+;;; tree-sitter-bench.el ends here

tests/tree-sitter-tests-utils.el

@@ -0,0 +1,140 @@
+;;; tree-sitter-tests-utils.el --- Utils for tree-sitter-tests.el -*- lexical-binding: t; coding: utf-8 -*-
+
+;; Copyright (C) 2019-2022  Tuấn-Anh Nguyễn
+;;
+;; Author: Tuấn-Anh Nguyễn <ubolonton@gmail.com>
+;; SPDX-License-Identifier: MIT
+
+;;; Commentary:
+
+;; Utils for `tree-sitter-tests'.
+
+;;; Code:
+
+(setq tsc-dyn-get-from nil)
+(require 'tree-sitter)
+(require 'tree-sitter-debug)
+
+(defvar tree-sitter-langs--testing)
+;;; Disable grammar downloading.
+(let ((tree-sitter-langs--testing t))
+  (require 'tree-sitter-langs))
+;;; Build the grammars, if necessary.
+(dolist (lang-symbol '(rust python javascript c))
+  (tree-sitter-langs-ensure lang-symbol))
+
+;; XXX: Bash grammar failed 'tree-sitter test' on Windows: 'Escaped newlines'.
+(with-demoted-errors "Failed to ensure bash grammar %s"
+  (tree-sitter-langs-ensure 'bash))
+
+(require 'ert)
+(require 'generator)
+
+(eval-when-compile
+  (require 'subr-x)
+  (require 'cl-lib))
+
+;;; ----------------------------------------------------------------------------
+;;; Helpers.
+
+(defun tsc-test-make-parser (lang-symbol)
+  "Return a new parser for LANG-SYMBOL."
+  (let ((parser (tsc-make-parser))
+        (language (tree-sitter-require lang-symbol)))
+    (tsc-set-language parser language)
+    parser))
+
+(defun tsc-test-full-path (relative-path)
+  "Return full path from project RELATIVE-PATH."
+  (concat (file-name-directory (locate-library "tree-sitter-tests.el"))
+          relative-path))
+
+(defun tsc-test-tree-sexp (sexp &optional reset)
+  "Check that the current syntax tree's sexp representation is SEXP.
+If RESET is non-nil, also do another full parse and check again."
+  (should (equal (read (tsc-tree-to-sexp tree-sitter-tree)) sexp))
+  (when reset
+    (setq tree-sitter-tree nil)
+    (tree-sitter--do-parse)
+    (tsc-test-tree-sexp sexp)))
+
+(defun tsc-test-use-lang (lang-symbol)
+  "Turn on `tree-sitter-mode' in the current buffer, using language LANG-SYMBOL."
+  (setq tree-sitter-language (tree-sitter-require lang-symbol))
+  (ignore-errors
+    (setq tree-sitter-hl-default-patterns
+          (tree-sitter-langs--hl-default-patterns lang-symbol)))
+  (add-hook 'tree-sitter-after-first-parse-hook
+            (lambda () (should (not (null tree-sitter-tree)))))
+  (tree-sitter-mode))
+
+(defun tsc--listify (x)
+  (if (listp x)
+      x
+    (list x)))
+
+(defun tsc--hl-at (pos face)
+  "Return t if text at POS is highlighted with FACE."
+  (memq face (tsc--listify (get-text-property pos 'face))))
+
+(defun tsc-test-no-op (&rest _args))
+
+(defvar tsc-test-no-op
+  (byte-compile #'tsc-test-no-op))
+
+(defun tsc-test-render-node (type named-p start-byte end-byte field depth)
+  (when named-p
+    (message "%s%s%S (%s . %s)" (make-string (* 2 depth) ?\ )
+             (if field
+                 (format "%s " field)
+               "")
+             type start-byte end-byte)))
+
+(defmacro tsc-test-with (lang-symbol var &rest body)
+  "Eval BODY with VAR bound to a new parser for LANG-SYMBOL."
+  (declare (indent 2))
+  `(let ((,var (tsc-test-make-parser ',lang-symbol)))
+     ,@body))
+
+(defmacro tsc-test-with-file (relative-path &rest body)
+  "Eval BODY in a temp buffer filled with content of the file at RELATIVE-PATH."
+  (declare (indent 1))
+  `(with-temp-buffer
+     (let ((coding-system-for-read 'utf-8))
+       (insert-file-contents (tsc-test-full-path ,relative-path)))
+     ,@body))
+
+(defmacro tsc-test-lang-with-file (lang-symbol relative-path &rest body)
+  "Eval BODY in a temp buffer filled with content of the file at RELATIVE-PATH.
+`tree-sitter-mode' is turned on, using the given language LANG-SYMBOL."
+  (declare (indent 2))
+  `(tsc-test-with-file ,relative-path
+     (tsc-test-use-lang ',lang-symbol)
+     ,@body))
+
+(defmacro tsc-test-with-advice (symbol where function &rest body)
+  "Eval BODY while advising SYMBOL with FUNCTION at WHERE."
+  (declare (indent 3))
+  `(progn
+     (advice-add ,symbol ,where ,function)
+     (unwind-protect
+         ,@body
+       (advice-remove ,symbol ,function))))
+
+(defmacro tsc-test-capture-messages (&rest body)
+  `(with-temp-buffer
+     (let ((buf (current-buffer)))
+       (tsc-test-with-advice 'message :override
+                             (lambda (fmt &rest args)
+                               (with-current-buffer buf
+                                 (insert (apply #'format-message fmt args) "\n")))
+         ,@body)
+       (with-current-buffer buf
+         (buffer-string)))))
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+(provide 'tree-sitter-tests-utils)
+;;; tree-sitter-tests-utils.el ends here