branch: externals/matlab-mode
commit 27f743e5476158d92e712dbdeda497263577d75c
Author: John Ciolfi <[email protected]>
Commit: John Ciolfi <[email protected]>
matlab-ts-mode: improve test structure
---
contributing/treesit-mode-how-to.org | 876 ++++++++++++++++++------------
matlab-ts-mode.el | 5 +-
tests/metest.el | 10 +-
tests/t-utils.el | 386 +++++++++++++
tests/test-matlab-ts-mode-font-lock.el | 170 ++----
tests/test-matlab-ts-mode-indent.el | 166 ++----
tests/test-matlab-ts-mode-syntax-table.el | 97 +---
7 files changed, 1010 insertions(+), 700 deletions(-)
diff --git a/contributing/treesit-mode-how-to.org
b/contributing/treesit-mode-how-to.org
index 1192c76b68..3df78b0f7b 100644
--- a/contributing/treesit-mode-how-to.org
+++ b/contributing/treesit-mode-how-to.org
@@ -31,9 +31,9 @@
#+latex_header: \advance\cftsubsecindent 0.5em\relax
#+latex_header: \advance\cftsubsecnumwidth 0.5em\relax
-#+title: Tree-Sitter How To
+#+title: How to Create an Emacs Tree-Sitter Major Mode
#+author: John Ciolfi
-#+date: Jun-22-2025
+#+date: Jun-25-2025
* TODO
@@ -43,10 +43,12 @@
matlab/bin/arch/mlint and looking for "Parse error". If no parse
error, then flag these as
issues with the matlab tree-sitter.
- Indent the file to see if matlab-ts-mode--indent-assert-rule fires
-- [ ] Add ./tests/test-runner.el
- [ ] Add test for comment handling
- [ ] Investigate
[[https://www.gnu.org/software/emacs/manual/html_mono/ert.html][ERT]] and
[[https://github.com/jorgenschaefer/emacs-buttercup][buttercup]] testing
-- [ ] When done, replace: matlab => LANGUAGE, .m => .lang, m-file => lang-file.
+- [ ] When done
+ + validate we replaced: matlab => LANGUAGE, .m => .lang, m-file => lang-file
+ + double check our t-utils.el programatically insert it
+ + programatically insert all tests?
* Guide to building a tree-sitter mode
@@ -271,7 +273,7 @@ and keywords.
(when (treesit-ready-p 'LANGUAGE)
(treesit-parser-create 'LANGUAGE)
- ;; Font-lock
+ ;; Font-lock. See: ./tests/test-matlab-ts-mode-font-lock.el
(setq-local treesit-font-lock-settings
LANGUAGE-ts-mode--font-lock-settings)
(setq-local treesit-font-lock-feature-list '((comment definition)
(keyword string type)
@@ -313,7 +315,7 @@ defaults to 3. If you'd like to have your font-lock default
to level 4, add:
)
#+end_src
-** Font-lock tests
+** Font-lock Tests
It is recommended that you create tests to validate your font-lock set up and
commit your tests with
your code together. This will make it easier for you and others to update your
code without causing
@@ -321,10 +323,10 @@ regressions. Under our LANGUAGE-ts-mode.el, we create a
tests subdirectory conta
#+begin_example
./LANGUAGE-ts-mode.el
- ./tests/test-runner.el
+ ./tests/t-utils.el // see
"Appendix: t-utils.el"
./tests/test-LANGUAGE-ts-mode-font-lock.el
./tests/test-LANGUAGE-ts-mode-font-lock-files/font_lock_test1.lang
- ./tests/test-LANGUAGE-ts-mode-font-lock-files/font_lock_test1_expected.txt
+ ./tests/test-LANGUAGE-ts-mode-font-lock-files/font_lock_test1_expected.txt
// generated for you
#+end_example
Where =tests/test-LANGUAGE-ts-mode-font-lock.el= is shown below. Notice that
there's a
@@ -343,143 +345,65 @@ after examining it, rename it to
To run your tests in a build system, use
#+begin_src bash
- emacs --batch -Q --eval "(setq debug-on-error t)" -l test-runner.el -eval
test-runner
+ emacs --batch -Q --eval "(setq debug-on-error t)" -l test-runner.el -eval
t-utils-run
#+end_src
#+begin_src emacs-lisp
;;; test-LANGUAGE-ts-mode-font-lock.el --- Test LANGUAGE-ts-mode font-lock
-*- lexical-binding: t -*-
- ;;; Code:
-
- (require 'cl-macs)
-
- ;; Add abs-path of ".." to load-path so we can (require 'LANGUAGE-ts-mode)
- (let* ((lf (or load-file-name (buffer-file-name (current-buffer))))
- (d1 (file-name-directory lf))
- (parent-dir (expand-file-name (file-name-directory
(directory-file-name d1)))))
- (add-to-list 'load-path parent-dir t))
-
- (require 'LANGUAGE-ts-mode)
-
- (defun test-LANGUAGE-ts-mode-font-lock-files ()
- "Return list of full paths to each
test-LANGUAGE-ts-mode-font-lock-files/*.lang."
- (directory-files "test-LANGUAGE-ts-mode-font-lock-files" t "\\.lang$"))
-
- (defvar test-LANGUAGE-ts-mode-font-lock
- (cons "test-LANGUAGE-ts-mode-font-lock"
(test-LANGUAGE-ts-mode-font-lock-files)))
-
- (cl-defun test-LANGUAGE-ts-mode-font-lock (&optional lang-file)
- "Test font-lock using ./test-LANGUAGE-ts-mode-font-lock-files/NAME.lang.
- Compare ./test-LANGUAGE-ts-mode-font-lock-files/NAME.lang against
- ./test-LANGUAGE-ts-mode-font-lock-files/NAME_expected.txt, where
- NAME_expected.txt is of same length as NAME.lang and has a character for
- each face set up by font-lock.
-
- If LANG-FILE NAME.lang is not provided, loop comparing all
- ./test-LANGUAGE-ts-mode-font-lock-files/NAME.lang files.
-
- For debugging, you can run with a specified NAME.lang,
- M-: (test-LANGUAGE-ts-mode-font-lock
\"test-LANGUAGE-ts-mode-font-lock-files/NAME.lang\")"
-
- (when (or (< emacs-major-version 30)
- (not (progn
- (require 'treesit)
- (when (fboundp 'treesit-ready-p)
- (treesit-ready-p 'LANGUAGE t)))))
- (message "skipping-test: test-LANGUAGE-ts-mode-font-lock.el - LANGUAGE
tree sitter not available.")
- (cl-return-from test-LANGUAGE-ts-mode-font-lock))
-
- (let* ((lang-files (if lang-file
- (progn
- (setq lang-file (file-truename lang-file))
- (when (not (file-exists-p lang-file))
- (error "File %s does not exist" lang-file))
- (list lang-file))
- (test-LANGUAGE-ts-mode-font-lock-files)))
- (code-to-face '(
- ("b" . font-lock-bracket-face)
- ("B" . font-lock-builtin-face)
- ("c" . font-lock-comment-face)
- ("C" . font-lock-comment-delimiter-face)
- ("d" . default)
- ("D" . font-lock-delimiter-face)
- ("f" . font-lock-function-name-face)
- ("h" . font-lock-doc-face)
- ("k" . font-lock-keyword-face)
- ("n" . font-lock-constant-face)
- ("s" . font-lock-string-face)
- ("P" . font-lock-property-name-face)
- ("t" . font-lock-type-face)
- ("v" . font-lock-variable-name-face)
- ("w" . font-lock-warning-face)
- ))
- (face-to-code (mapcar (lambda (pair)
- (cons (cdr pair) (car pair)))
- code-to-face)))
- (dolist (lang-file lang-files)
- (save-excursion
- (message "START: test-LANGUAGE-ts-mode-font-lock %s" lang-file)
-
- (when (boundp 'treesit-font-lock-level)
- (setq treesit-font-lock-level 4))
-
- (find-file lang-file)
-
- ;; Force font lock to throw catchable errors.
- (font-lock-mode 1)
- (font-lock-flush (point-min) (point-max))
- (font-lock-ensure (point-min) (point-max))
-
- (goto-char (point-min))
- (let* ((got "")
- (expected-file (replace-regexp-in-string "\\.lang$"
"_expected.txt"
- lang-file))
- (got-file (concat expected-file "~"))
- (expected (when (file-exists-p expected-file)
- (with-temp-buffer
- (insert-file-contents-literally expected-file)
- (buffer-string)))))
- (while (not (eobp))
- (let* ((face (if (face-at-point) (face-at-point) 'default))
- (code (if (looking-at "\\([ \t\n]\\)")
- (match-string 1)
- (cdr (assoc face face-to-code)))))
- (when (not code)
- (error "Face, %S, is not in face-to-code alist" face))
- (setq got (concat got code))
- (forward-char)
- (when (looking-at "\n")
- (setq got (concat got "\n"))
- (forward-char))))
-
- (when (not (string= got expected))
- (let ((coding-system-for-write 'raw-text-unix))
- (write-region got nil got-file))
- (when (not expected)
- (error "Baseline for %s does not exists. \
- See %s and if it looks good rename it to %s"
- lang-file got-file expected-file))
- (when (= (length got) (length expected))
- (let* ((diff-idx (1- (compare-strings got nil nil expected nil
nil)))
- (got-code (substring got diff-idx (1+ diff-idx)))
- (got-face (cdr (assoc got-code code-to-face)))
- (expected-code (substring expected diff-idx (1+
diff-idx)))
- (expected-face (cdr (assoc expected-code
code-to-face))))
- (error "Baseline for %s does not match, got: %s, expected:
%s. \
- Difference at column %d (got code-to-face \"%s\" . %S, expected code-to-face
\"%s\" . %S"
- lang-file got-file expected-file
- diff-idx
- got-code got-face
- expected-code expected-face)))
- (error "Baseline for %s does not match, lengths are different,
got: %s, expected: %s"
- lang-file got-file expected-file))
- (kill-buffer)))
- (message "PASS: test-LANGUAGE-ts-mode-font-lock %s" lang-file)))
- "success")
+ ;;; Commentary:
- (provide 'test-LANGUAGE-ts-mode-font-lock)
- ;;; test-LANGUAGE-ts-mode-font-lock.el ends here
+ ;;; Code:
+ (require 't-utils)
+ (require 'language-ts-mode)
+
+ (cl-defun test-language-ts-mode-font-lock (&optional lang-file)
+ "Test font-lock using ./test-language-ts-mode-font-lock-files/NAME.lang.
+ Compare ./test-language-ts-mode-font-lock-files/NAME.lang against
+ ./test-language-ts-mode-font-lock-files/NAME_expected.txt, where
+ NAME_expected.txt is of same length as NAME.lang where each source
+ character in NAME.lang is replaced with a character code representing the
+ font-lock face used for said source character. The mapping is defined
+ by the code-to-face alist setup by this function. If LANG-FILE is not
+ provided, loop comparing all
+ ./test-language-ts-mode-font-lock-files/NAME.lang files.
+
+ To add a test, create
+ ./test-language-ts-mode-font-lock-files/NAME.lang
+ and run this function. The baseline is saved for you as
+ ./test-language-ts-mode-font-lock-files/NAME_expected.lang~
+ after validating it, rename it to
+ ./test-language-ts-mode-font-lock-files/NAME_expected.lang"
+
+ (let ((test-name "test-language-ts-mode-font-lock"))
+ (when (not (t-utils-is-treesit-available 'language test-name))
+ (cl-return-from test-language-ts-mode-font-lock))
+
+ (let* ((lang-files (t-utils-get-files (concat test-name "-files")
"\\.lang$" nil lang-file))
+ (code-to-face '(
+ ("b" . font-lock-bracket-face)
+ ("B" . font-lock-builtin-face)
+ ("c" . font-lock-comment-face)
+ ("C" . font-lock-comment-delimiter-face)
+ ("d" . default)
+ ("D" . font-lock-delimiter-face)
+ ("f" . font-lock-function-name-face)
+ ("h" . font-lock-doc-face)
+ ("k" . font-lock-keyword-face)
+ ("n" . font-lock-constant-face)
+ ("s" . font-lock-string-face)
+ ("P" . font-lock-property-name-face)
+ ("t" . font-lock-type-face)
+ ("v" . font-lock-variable-name-face)
+ ("w" . font-lock-warning-face)
+ )))
+ (t-utils-test-font-lock test-name lang-files code-to-face))
+ ;; return "success" for M-: (test-language-ts-mode-font-lock)
+ "success"))
+
+ (provide 'test-language-ts-mode-font-lock)
+ ;;; test-language-ts-mode-font-lock.el ends here
#+end_src
* Indent
@@ -529,14 +453,14 @@ the tests.
(when (treesit-ready-p 'LANGUAGE)
(treesit-parser-create 'LANGUAGE)
- ;; Font-lock
+ ;; Font-lock. See: ./tests/test-matlab-ts-mode-font-lock.el
(setq-local treesit-font-lock-settings
LANGUAGE-ts-mode--font-lock-settings)
(setq-local treesit-font-lock-feature-list '((comment definition)
(keyword string type)
(number bracket delimiter)
(syntax-error)))
- ;; Indent
+ ;; Indent. See: ./tests/test-matlab-ts-mode-indent.el
(setq-local treesit-simple-indent-rules
(if treesit--indent-verbose ;; add debugging print as first
rule?
(list (append `,(list (caar
LANGUAGE-ts-mode--indent-rules))
@@ -621,8 +545,8 @@ we'll see in the =*Messages*= buffer we'll see in the
=*Messages*= buffer:
: -->N:#<treesit-node block in 14-24> P:#<treesit-node if_statement in 1-48>
BOL:14 GP:#<treesit-node source_file in 1-49> NPS:#<treesit-node "
-where point 14-24 is "b = a * 2" and we see it has a node named "block". Thus,
we update we add to our
-indent rules, =((node-is "block") parent 4)= and a couple more rules as shown
below. Notice we
+where point 14-24 is "b = a * 2" and we see it has a node named "block". Thus,
we update we add to
+our indent rules, =((node-is "block") parent 4)= and a couple more rules as
shown below. Notice we
included a comment before each rule, which will aid in the long-term maintance
of the code. If the
font-lock rules are complex, you may also want to add ";; F-Rule: description"
comments to them.
@@ -742,14 +666,14 @@ so we can combine them and also handle handle nested
if-statements as shown belo
(when (treesit-ready-p 'LANGUAGE)
(treesit-parser-create 'LANGUAGE)
- ;; Font-lock
+ ;; Font-lock. See: ./tests/test-matlab-ts-mode-font-lock.el
(setq-local treesit-font-lock-settings
LANGUAGE-ts-mode--font-lock-settings)
(setq-local treesit-font-lock-feature-list '((comment definition)
(keyword string type)
(number bracket delimiter)
(syntax-error)))
- ;; Indent
+ ;; Indent. See: ./tests/test-matlab-ts-mode-indent.el
(setq-local treesit-simple-indent-rules
(if treesit--indent-verbose ;; add debugging print as first
rule?
(list (append `,(list (caar
LANGUAGE-ts-mode--indent-rules))
@@ -766,163 +690,70 @@ so we can combine them and also handle handle nested
if-statements as shown belo
Following this process, we complete our our indent engine by adding more
rules. As we develop
the rules, it is good to lockdown expected behavior with tests.
-** Indent tests
+** Indent Tests
-We copy the font-lock pattern for our indent tests:
+We use a similar pattern for our indent tests:
#+begin_example
./LANGUAGE-ts-mode.el
- ./tests/test-runner.el
./tests/test-LANGUAGE-ts-mode-indent.el
./tests/test-LANGUAGE-ts-mode-indent-files/font_lock_test1.lang
- ./tests/test-LANGUAGE-ts-mode-indent-files/font_lock_test1_expected.txt
+ ./tests/test-LANGUAGE-ts-mode-indent-files/font_lock_test1_expected.lang //
generated for you
#+end_example
where test-LANGUAGE-ts-mode-indent.el contains:
#+begin_src emacs-lisp
- ;;; test-matlab-ts-mode-indent.el --- Test matlab-ts-mode indent -*-
lexical-binding: t -*-
+ ;;; test-LANGUAGE-ts-mode-indent.el --- Test LANGUAGE-ts-mode indent -*-
lexical-binding: t -*-
;;; Commentary:
- ;; <snip>
;;; Code:
- (require 'cl-seq)
-
- ;; Add abs-path of ".." to load-path so we can (require 'matlab-ts-mode)
- (let* ((lf (or load-file-name (buffer-file-name (current-buffer))))
- (d1 (file-name-directory lf))
- (parent-dir (expand-file-name (file-name-directory
(directory-file-name d1)))))
- (add-to-list 'load-path parent-dir t))
-
+ (require 't-utils)
(require 'LANGUAGE-ts-mode)
- (setq LANGUAGE-ts-mode--indent-assert t)
-
- (defun test-LANGUAGE-ts-mode-indent-files ()
- "Return list of full paths to each
test-LANGUAGE-ts-mode-indent-files/*.lang."
- (cl-delete-if (lambda (lang-file)
- (string-match "_expected\\.lang$" lang-file))
- (directory-files "test-LANGUAGE-ts-mode-indent-files" t
"\\.lang$")))
-
- (defvar test-LANGUAGE-ts-mode-indent (cons "test-LANGUAGE-ts-mode-indent"
-
(test-LANGUAGE-ts-mode-indent-files)))
-
- (defun test-LANGUAGE-ts-mode-indent--trim ()
- "Trim trailing whitespace and lines."
- (setq buffer-file-coding-system 'utf-8-unix)
- (let ((delete-trailing-lines t))
- (delete-trailing-whitespace (point-min) (point-max))))
-
- (defun test-LANGUAGE-ts-mode-indent--typing (lang-file expected
expected-file)
- "Exercise indent by simulating the creation of LANG-FILE via typing.
- This compares the simulation of typing LANG-FILE line by line against
- EXPECTED content in EXPECTED-FILE."
-
- (message "START: test-LANGUAGE-ts-mode-indent (typing) %s" lang-file)
-
- (let* ((typing-lang-file-name (concat "typing__" (file-name-nondirectory
lang-file)))
- (contents (with-temp-buffer
- (insert-file-contents-literally lang-file)
- (buffer-substring (point-min) (point-max))))
- (lines (split-string (string-trim contents) "\n")))
- (with-current-buffer (get-buffer-create typing-lang-file-name)
- (erase-buffer)
- (LANGUAGE-ts-mode)
-
- ;; Insert the non-empty lines into typing-lang-file-name buffer
- (dolist (line lines)
- (setq line (string-trim line))
- (when (not (string= line ""))
- (insert line "\n")))
-
- ;; Now indent each line and insert the empty ("") lines into
typing-lang-file-buffer
- ;; as we indent. This exercises the RET and TAB behaviors which cause
different
- ;; tree-sitter nodes to be provided to the indent engine rules.
- (goto-char (point-min))
- (while (not (eobp))
-
- (call-interactively #'indent-for-tab-command) ;; TAB on code just
added
-
- ;; While next line in our original contents is a newline insert "\n"
- (while (let ((next-line (nth (line-number-at-pos (point)) lines)))
- (and next-line (string-match-p "^[ \t\r]*$" next-line)))
- (goto-char (line-end-position))
- ;; RET to add blank line
- (call-interactively #'newline)
- ;; TAB on the same blank line can result in different tree-sitter
nodes than
- ;; the RET, so exercise that.
- (call-interactively #'indent-for-tab-command))
- (forward-line))
-
- (test-LANGUAGE-ts-mode-indent--trim)
-
- (let ((typing-got (buffer-substring (point-min) (point-max))))
- (set-buffer-modified-p nil)
- (kill-buffer)
- (when (not (string= typing-got expected))
- (let ((coding-system-for-write 'raw-text-unix)
- (typing-got-file (replace-regexp-in-string "\\.lang$"
"_typing.lang~" lang-file)))
- (write-region typing-got nil typing-got-file)
- (error "Typing %s line-by-line does not match %s, we got %s"
lang-file expected-file
- typing-got-file)))))))
-
- (defun test-LANGUAGE-ts-mode-indent (&optional lang-file)
+ (cl-defun test-LANGUAGE-ts-mode-indent (&optional lang-file)
"Test indent using ./test-LANGUAGE-ts-mode-indent-files/NAME.lang.
Compare indent of ./test-LANGUAGE-ts-mode-indent-files/NAME.lang against
- ./test-LANGUAGE-ts-mode-indent-files/NAME_expected.lang
-
- If LANG-FILE (NAME.lang) is not provided, loop comparing all
- ./test-LANGUAGE-ts-mode-indent-files/NAME.lang files.
-
- For debugging, you can run with a specified NAME.lang,
- M-: (test-LANGUAGE-ts-mode-font-lock
\"test-LANGUAGE-ts-mode-indent-files/NAME.lang\")"
-
- (let* ((lang-files (if lang-file
- (progn
- (setq lang-file (file-truename lang-file))
- (when (not (file-exists-p lang-file))
- (error "File %s does not exist" lang-file))
- (list lang-file))
- (test-LANGUAGE-ts-mode-indent-files))))
- (dolist (lang-file lang-files)
- (let* ((expected-file (replace-regexp-in-string "\\.lang$"
"_expected.lang" lang-file))
- (expected (when (file-exists-p expected-file)
- (with-temp-buffer
- (insert-file-contents-literally expected-file)
- (buffer-string)))))
-
- (save-excursion
- (message "START: test-LANGUAGE-ts-mode-indent %s" lang-file)
- (find-file lang-file)
- (indent-region (point-min) (point-max))
- (test-LANGUAGE-ts-mode-indent--trim)
- (let ((got (buffer-substring (point-min) (point-max)))
- (got-file (concat expected-file "~")))
- (set-buffer-modified-p nil)
- (kill-buffer)
- (when (not (string= got expected))
- (let ((coding-system-for-write 'raw-text-unix))
- (write-region got nil got-file))
- (when (not expected)
- (error "Baseline for %s does not exists - if %s looks good
rename it to %s"
- lang-file got-file expected-file))
- (error "Baseline for %s does not match, got: %s, expected: %s"
- lang-file got-file expected-file))))
-
- (when expected ;; expected-file exists?
- (test-LANGUAGE-ts-mode-indent--typing lang-file expected
expected-file)))
-
- (message "PASS: test-LANGUAGE-ts-mode-indent %s" lang-file)))
+ ./test-LANGUAGE-ts-mode-indent-files/NAME_expected.lang. Indent is done two
+ ways as described in `t-utils-test-indent'. If LANG-FILE is not provided,
+ loop comparing all ./test-LANGUAGE-ts-mode-indent-files/NAME.lang files.
+
+ To add a test, create
+ ./test-LANGUAGE-ts-mode-indent-files/NAME.lang
+ and run this function. The baseline is saved for you as
+ ./test-LANGUAGE-ts-mode-indent-files/NAME_expected.lang~
+ after validating it, rename it to
+ ./test-LANGUAGE-ts-mode-indent-files/NAME_expected.lang"
+
+ (let ((test-name "test-LANGUAGE-ts-mode-indent")
+ (LANGUAGE-ts-mode--indent-assert t))
+
+ (when (not (t-utils-is-treesit-available 'LANGUAGE test-name))
+ (cl-return-from test-LANGUAGE-ts-mode-font-lock))
+
+ (let ((lang-files (t-utils-get-files (concat test-name "-files")
"\\.lang$"
+ "_expected\\.lang$" ;; skip our
*_expected.lang baselines
+ lang-file))
+ (line-manipulator (lambda ()
+ ;; Workaround
+ ;;
https://github.com/acristoffers/tree-sitter-LANGUAGE/issues/32
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((node (treesit-node-at (point)))
+ (parent (and node
(treesit-node-parent node))))
+ (when (string= (treesit-node-type parent)
"ERROR")
+ (insert " ")))
+ (forward-line)))))
+
+ (t-utils-test-indent test-name lang-files line-manipulator)))
+ ;; return "success" for M-: (test-LANGUAGE-ts-mode-font-lock)
"success")
- (provide 'test-LANGUAGE-ts-mode-indent)
- ;;; test-LANGUAGE-ts-mode-indent.el ends here
-
#+end_src
-* Syntax table and comments
+* Syntax Table and Comments
The Emacs "syntax table" is not related to the syntax tree created by
tree-sitter. A syntax tree
represents the hierarchical structure of your source code, giving a structural
blueprint of your
@@ -1116,7 +947,7 @@ This is good practice because these are fundamental to
Emacs.
;;; LANGUAGE-ts-mode.el ends here
#+end_src
-** Syntax table tests
+** Syntax Table Tests
We follow a similar pattern for writing syntax table tests.
@@ -1125,93 +956,34 @@ We follow a similar pattern for writing syntax table
tests.
;;; Commentary:
- ;; <snip>
-
;;; Code:
- (require 'cl-macs)
-
- ;; Add abs-path of ".." to load-path so we can (require 'LANGUAGE-ts-mode)
- (let* ((lf (or load-file-name (buffer-file-name (current-buffer))))
- (d1 (file-name-directory lf))
- (parent-dir (expand-file-name (file-name-directory
(directory-file-name d1)))))
- (add-to-list 'load-path parent-dir t))
-
+ (require 't-utils)
(require 'LANGUAGE-ts-mode)
- (defun test-LANGUAGE-ts-mode-syntax-table-files ()
- "Return list of full paths to each
test-LANGUAGE-ts-mode-syntax-table-files/*.lang."
- (directory-files "test-LANGUAGE-ts-mode-syntax-table-files" t "\\.lang$"))
-
- (defvar test-LANGUAGE-ts-mode-syntax-table
- (cons "test-LANGUAGE-ts-mode-syntax-table"
(test-LANGUAGE-ts-mode-syntax-table-files)))
-
(cl-defun test-LANGUAGE-ts-mode-syntax-table (&optional lang-file)
"Test syntax-table using
./test-LANGUAGE-ts-mode-syntax-table-files/NAME.lang.
Compare ./test-LANGUAGE-ts-mode-syntax-table-files/NAME.lang against
./test-LANGUAGE-ts-mode-syntax-table-files/NAME_expected.txt, where
- NAME_expected.txt gives the `syntax-ppss` value of each character in
NAME.lang
-
- If LANG-FILE NAME.lang is not provided, loop comparing all
- ./test-LANGUAGE-ts-mode-syntax-table-files/NAME.lang files.
-
- For debugging, you can run with a specified NAME.lang,
- M-: (test-LANGUAGE-ts-mode-syntax-table
\"test-LANGUAGE-ts-mode-syntax-table-files/NAME.lang\")"
-
- (when (or (< emacs-major-version 30)
- (not (progn
- (require 'treesit)
- (when (fboundp 'treesit-ready-p)
- (treesit-ready-p 'LANGUAGE t)))))
- (message "skipping-test: test-LANGUAGE-ts-mode-syntax-table.el - tree
sitter not available.")
- (cl-return-from test-LANGUAGE-ts-mode-syntax-table))
-
- (let ((lang-files (if lang-file
- (progn
- (setq lang-file (file-truename lang-file))
- (when (not (file-exists-p lang-file))
- (error "File %s does not exist" lang-file))
- (list lang-file))
- (test-LANGUAGE-ts-mode-syntax-table-files))))
- (dolist (lang-file lang-files)
- (save-excursion
- (message "START: test-LANGUAGE-ts-mode-syntax-table %s" lang-file)
-
- (find-file lang-file)
- (goto-char (point-min))
-
- (let* ((got "")
- (expected-file (replace-regexp-in-string "\\.lang$"
"_expected.txt" lang-file))
- (got-file (concat expected-file "~"))
- (expected (when (file-exists-p expected-file)
- (with-temp-buffer
- (insert-file-contents-literally expected-file)
- (buffer-string)))))
- (while (not (eobp))
- (when (looking-at "^")
- (setq got (concat got (format "Line:%d: %s\n"
- (line-number-at-pos)
- (buffer-substring-no-properties
(point)
-
(line-end-position))))))
-
- (let ((char (buffer-substring-no-properties (point) (1+
(point)))))
- (when (string= char "\n")
- (setq char "\\n"))
- (setq got (concat got (format " %2s: %S\n" char (syntax-ppss
(point))))))
-
- (forward-char))
+ NAME_expected.txt gives the `syntax-ppss` value of each character in
+ NAME.lang. If LANG-FILE is not provided, loop comparing all
+ ./test-LANGUAGE-ts-mode-indent-files/NAME.lang files.
- (when (not (string= got expected))
- (let ((coding-system-for-write 'raw-text-unix))
- (write-region got nil got-file))
- (when (not expected)
- (error "Baseline for %s does not exists. \
- See %s and if it looks good rename it to %s"
- lang-file got-file expected-file))
- (error "Baseline for %s does not match, got: %s, expected: %s"
- lang-file got-file expected-file))
- (kill-buffer)))
- (message "PASS: test-LANGUAGE-ts-mode-syntax-table %s" lang-file)))
+ To add a test, create
+ ./test-LANGUAGE-ts-mode-syntax-table-files/NAME.lang
+ and run this function. The baseline is saved for you as
+ ./test-LANGUAGE-ts-mode-syntax-table-files/NAME_expected.lang~
+ after validating it, rename it to
+ ./test-LANGUAGE-ts-mode-syntax-table-files/NAME_expected.lang"
+
+ (let ((test-name "test-LANGUAGE-ts-mode-syntax-table"))
+ (when (not (t-utils-is-treesit-available 'LANGUAGE test-name))
+ (cl-return-from test-LANGUAGE-ts-mode-syntax-table))
+
+ (let ((lang-files (t-utils-get-files (concat test-name "-files")
"\\.lang$" nil lang-file)))
+ (t-utils-test-syntax-table test-name lang-files)))
+
+ ;; return "success" for M-: (test-LANGUAGE-ts-mode-font-lock)
"success")
(provide 'test-LANGUAGE-ts-mode-syntax-table)
@@ -1271,6 +1043,398 @@ https://github.com/emacs-tree-sitter/tree-sitter-langs
and place it in
These downsides are relatively minor compared with the benefits of a
tree-sitter powered mode. It is
well worth writing a tree-sitter mode.
+* Appendix: t-utils.el
+
+#+begin_src emacs-lisp
+ ;;; t-utils.el --- Test utilities -*- lexical-binding: t -*-
+ ;;
+ ;; Copyright 2025 Free Software Foundation, Inc.
+ ;;
+ ;; This program is free software; you can redistribute it and/or modify
+ ;; it under the terms of the GNU General Public License as published by
+ ;; the Free Software Foundation; either version 3, or (at your option)
+ ;; any later version.
+ ;;
+ ;; This program is distributed in the hope that it will be useful,
+ ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ ;; GNU General Public License for more details.
+ ;;
+ ;; You should have received a copy of the GNU General Public License
+ ;; along with GNU Emacs; see the file COPYING. If not, write to
+ ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ ;;
+
+ ;;; Commentary:
+ ;;
+ ;; Test utilities used by test-*.el files.
+ ;;
+
+ ;;; Code:
+
+ (require 'cl-seq)
+
+ ;; Add abs-path of ".." to load-path so we can require packages from above
us.
+ (let* ((lf (or load-file-name (buffer-file-name (current-buffer))))
+ (d1 (file-name-directory lf))
+ (parent-dir (expand-file-name (file-name-directory
(directory-file-name d1)))))
+ (add-to-list 'load-path parent-dir t))
+
+ (defun t-utils-trim ()
+ "Trim trailing whitespace and lines with utf-8-unix encoding."
+ (setq buffer-file-coding-system 'utf-8-unix)
+ (let ((delete-trailing-lines t))
+ (delete-trailing-whitespace (point-min) (point-max))))
+
+ (defun t-utils-get-files (subdir base-regexp &optional skip-regexp
file-to-use)
+ "Return list of full paths, /path/to/SUBDIR/FILE.
+ The FILE basenames returned match BASE-REGEXP.
+ Files matching optional SKIP-REGEXP are ignored.
+ Optional FILE-TO-USE narrow the list of full paths to that file
+ and the result is a list of one file.
+
+ For example,
+ (t-utils-get-files \"test-LANGUAGE-ts-mode-files\"
+ \"*\\.lang$\" \"_expected\\.lang$\" file-to-use)
+ will return a list of /path/to/test-NAME/*.lang files, skipping
+ all *_expected.lang files when file-to-use is nil."
+
+ (let ((files (cl-delete-if (lambda (file)
+ (and skip-regexp
+ (string-match skip-regexp file)))
+ (directory-files subdir t base-regexp))))
+ (when file-to-use
+ (let ((true-file-to-use (file-truename file-to-use)))
+ (when (not (member true-file-to-use files))
+ (if (file-exists-p true-file-to-use)
+ (error "File %s, resolved to %s, is not a valid selection.
+ It should be one of %S" file-to-use true-file-to-use files)
+ (error "File %s does not exist" file-to-use)))
+ (setq files (list true-file-to-use))))
+ files))
+
+ (defun t-utils-is-treesit-available (language test-name)
+ "Is tree-sitter ready for LANGUAGE?
+ If not available a message saying skipping TEST-NAME is displayed."
+ (let ((available (and (>= emacs-major-version 30) ;; treesit package comes
with Emacs 30
+ (progn
+ (require 'treesit)
+ (when (fboundp 'treesit-ready-p)
+ (treesit-ready-p language t))))))
+ (when (not available)
+ (message "skipping-test: %s - %S tree sitter not available." test-name
language))
+ available))
+
+ (defun t-utils-run (&optional match)
+ "Run test files in current directory matching regexp, MATCH.
+ If optional MATCH is non-nil, only run test file names whose
+ non-directory part matches the regexp, MATCH. For example,
+ \"^test-foo.*\\\\.el$\" would run tell t-run to run \"test-foo*.el$\"
+ files. The default MATCH is \"^test-.*\\\\.el$\""
+ (when (not match)
+ (setq match "^test-.*\\.el$"))
+
+ (dolist (test-file (directory-files "." t match))
+ (when (not (load-file test-file))
+ (error "Failed to load %s" test-file))
+ (let ((test-fun (intern
+ (replace-regexp-in-string "\\.el" ""
(file-name-nondirectory test-file)))))
+ (funcall test-fun))))
+
+ (defun t-utils--took (start-time)
+ "Return \"- took N seconds\".
+ N is `current-time' minus START-TIME."
+ (format "- took %.2f seconds" (float-time (time-subtract (current-time)
start-time))))
+
+ (defun t-utils-test-font-lock (test-name lang-files code-to-face)
+ "Test font-lock using on each lang-file in LANG-FILES list.
+ Foreach file in LANG-FILES compare the file against NAME_expected.txt, where
+ NAME the file name minus the extension. NAME_expected.txt is of same
+ length as the file and has a character for each face setup by font-lock.
+ CODE_TO_FACE is an alist where each elment is (CHAR . FACE).
+ TEST-NAME is used when displaying messages.
+
+ If NAME_expected.txt does not exists or doesn't match the results we
+ got, a NAME_expected.txt~ will be generated. After reviewing
+ NAME_expected.txt~, you should rename it to NAME_expected.txt or fix
+ your code and rerun the test.
+
+ For example, suppose our LANG-FILE contains
+ int foo(void) {
+ return 1;
+ }
+ our NAME_expected.txt will contain:
+ kkk fffDkkkkD b
+ kkkkkk nD
+ D
+ where int and void are keywords, etc. and CODE-TO-FACE contains:
+ \\='((\"b\" . font-lock-bracket-face)
+ (\"d\" . default)
+ (\"D\" . font-lock-delimiter-face)
+ (\"f\" . font-lock-function-name-face)
+ (\"k\" . font-lock-keyword-face)
+ (\"n\" . font-lock-constant-face))"
+
+ (let ((face-to-code (mapcar (lambda (pair)
+ (cons (cdr pair) (car pair)))
+ code-to-face)))
+ (dolist (lang-file lang-files)
+ (save-excursion
+ (let ((start-time (current-time)))
+ (message "START: %s %s" test-name lang-file)
+
+ (when (boundp 'treesit-font-lock-level)
+ (setq treesit-font-lock-level 4))
+
+ (find-file lang-file)
+
+ ;; Force font lock to throw catchable errors.
+ (font-lock-mode 1)
+ (font-lock-flush (point-min) (point-max))
+ (font-lock-ensure (point-min) (point-max))
+
+ (goto-char (point-min))
+ (let* ((got "")
+ (expected-file (replace-regexp-in-string "\\.[^.]+$"
"_expected.txt"
+ lang-file))
+ (got-file (concat expected-file "~"))
+ (expected (when (file-exists-p expected-file)
+ (with-temp-buffer
+ (insert-file-contents-literally expected-file)
+ (buffer-string)))))
+ (while (not (eobp))
+ (let* ((face (if (face-at-point) (face-at-point) 'default))
+ (code (if (looking-at "\\([ \t\n]\\)")
+ (match-string 1)
+ (cdr (assoc face face-to-code)))))
+ (when (not code)
+ (error "Face, %S, is not in code-to-face alist" face))
+ (setq got (concat got code))
+ (forward-char)
+ (when (looking-at "\n")
+ (setq got (concat got "\n"))
+ (forward-char))))
+
+ (when (not (string= got expected))
+ (let ((coding-system-for-write 'raw-text-unix))
+ (write-region got nil got-file))
+ (when (not expected)
+ (error "Baseline for %s does not exists. \
+ See %s and if it looks good rename it to %s"
+ lang-file got-file expected-file))
+ (when (= (length got) (length expected))
+ (let* ((diff-idx (1- (compare-strings got nil nil expected
nil nil)))
+ (got-code (substring got diff-idx (1+ diff-idx)))
+ (got-face (cdr (assoc got-code code-to-face)))
+ (expected-code (substring expected diff-idx (1+
diff-idx)))
+ (expected-face (cdr (assoc expected-code
code-to-face))))
+ (error "Baseline for %s does not match, got: %s, expected:
%s. \
+ Difference at column %d: got code-to-face (\"%s\" . %S), expected
code-to-face (\"%s\" . %S)"
+ lang-file got-file expected-file
+ diff-idx
+ got-code got-face
+ expected-code expected-face)))
+ (error "Baseline for %s does not match, lengths are different,
got: %s, expected: %s"
+ lang-file got-file expected-file))
+ (kill-buffer))
+ (message "PASS: %s %s %s" test-name lang-file (t-utils--took
start-time)))))))
+
+ (defun t-utils--test-indent-typing (lang-file lang-file-mode
+ expected expected-file
+ &optional line-manipulator)
+ "Exercise indent by simulating the creation of LANG-FILE via typing.
+ This compares the simulation of typing LANG-FILE against the
+ EXPECTED content in EXPECTED-FILE
+
+ The typing occurs in a buffer named \"typing__NAME.EXT\" where NAME.EXT
+ is the basename of LANG-FILE.
+
+ The typing buffer is initialized with the string-trim'd version of the
+ non-empty lines of LANG-FILE. If optional LINE-MANIPULATOR function is
+ specified, it is called with the typing buffer as the current
+ buffer. LINE-MANIPULATOR should only adjust whitespace in the lines. It
+ should not add newlines to the buffer. LINE-MANIPULATOR is called from
+ within a `save-excursion', so your function doesn't need to do that.
+
+ After initializating the typing buffer, it's mode is set to
+ LANG-FILE-MODE. Each line is then indented via `indent-for-tab-command'
+ and blank lines are inserted by calling `newline'.`"
+
+ (let* ((typing-lang-file-name (concat "typing__" (file-name-nondirectory
lang-file)))
+ (contents (with-temp-buffer
+ (insert-file-contents-literally lang-file)
+ (buffer-substring (point-min) (point-max))))
+ (lines (split-string (string-trim contents) "\n")))
+ (with-current-buffer (get-buffer-create typing-lang-file-name)
+ (erase-buffer)
+ (funcall lang-file-mode)
+
+ ;; Insert the non-empty lines into typing-lang-file-name buffer
+ (dolist (line lines)
+ (setq line (string-trim line))
+ (when (not (string= line ""))
+ (insert line "\n")))
+
+ (goto-char (point-min))
+
+ (when line-manipulator
+ (save-excursion
+ (funcall line-manipulator)))
+
+ ;; Now indent each line and insert the empty ("") lines into
typing-lang-file-buffer
+ ;; as we indent. This exercises the RET and TAB behaviors which cause
different
+ ;; tree-sitter nodes to be provided to the indent engine rules.
+ (while (not (eobp))
+
+ (call-interactively #'indent-for-tab-command) ;; TAB on code just
added
+
+ ;; While next line in our original contents is a newline insert "\n"
+ (while (let ((next-line (nth (line-number-at-pos (point)) lines)))
+ (and next-line (string-match-p "^[ \t\r]*$" next-line)))
+ (goto-char (line-end-position))
+ ;; RET to add blank line
+ (call-interactively #'newline)
+ ;; TAB on the same blank line can result in different tree-sitter
nodes than
+ ;; the RET, so exercise that.
+ (call-interactively #'indent-for-tab-command))
+ (forward-line))
+
+ (t-utils-trim)
+
+ (let ((typing-got (buffer-substring (point-min) (point-max))))
+ (set-buffer-modified-p nil)
+ (kill-buffer)
+ (when (not (string= typing-got expected))
+ (let ((coding-system-for-write 'raw-text-unix)
+ (typing-got-file (replace-regexp-in-string "\\.\\([^.]+\\)$"
+ "_typing.\\1~"
+ lang-file)))
+ (write-region typing-got nil typing-got-file)
+ (error "Typing %s line-by-line does not match %s, we got %s"
lang-file expected-file
+ typing-got-file)))))))
+
+ (defun t-utils-test-indent (test-name lang-files &optional line-manipulator)
+ "Test indent on each file in LANG-FILES list.
+ Compare indent of each NAME.EXT in LANG-FILES against NAME_expected.EXT.
+ TEST-NAME is used in messages.
+
+ If NAME_expected.EXT does not exist or the indent of NAME.EXT doesn't
+ match NAME_expected.txt, NAME_expected.EXT~ will be created. You are
+ then instructured to validate the indent and rename NAME_expected.EXT~
+ to NAME_expected.EXT.
+
+ To add a test for TEST-NAME.el, in it's corresponding TEST-NAME-files/
+ directory, create TEST-NAME-files/NAME.EXT, then run the test. Follow
+ the messages to accept the generated baseline after validating it.
+
+ Two methods are used to indent each file in LANG-FILES,
+ 1. (indent-region (point-min) (point-man))
+ 2. Simulation of typing lang-file to exercise TAB and RET,
+ see `t-utils--test-indent-typing'. In tree-sitter modes, TAB and RET
+ need to be handled and this verifies they are handled.
+
+ See `t-utils--test-indent-type' for LINE-MANIPULATOR."
+
+ (dolist (lang-file lang-files)
+ (let* ((expected-file (replace-regexp-in-string "\\.\\([^.]+\\)$"
"_expected.\\1" lang-file))
+ (expected (when (file-exists-p expected-file)
+ (with-temp-buffer
+ (insert-file-contents-literally expected-file)
+ (buffer-string))))
+ lang-file-major-mode)
+
+ ;; Indent lang-file
+ (save-excursion
+ (let ((start-time (current-time)))
+ (message "START: %s <indent-region> %s" test-name lang-file)
+ (find-file lang-file)
+ (setq lang-file-major-mode major-mode)
+ (indent-region (point-min) (point-max))
+ (t-utils-trim)
+ (let ((got (buffer-substring (point-min) (point-max)))
+ (got-file (concat expected-file "~")))
+ (set-buffer-modified-p nil)
+ (kill-buffer)
+ (when (not (string= got expected))
+ (let ((coding-system-for-write 'raw-text-unix))
+ (write-region got nil got-file))
+ (when (not expected)
+ (error "Baseline for %s does not exists - if %s looks good
rename it to %s"
+ lang-file got-file expected-file))
+ (error "Baseline for %s does not match, got: %s, expected: %s"
+ lang-file got-file expected-file)))
+ (message "PASS: %s <indent-region> %s %s" test-name lang-file
+ (t-utils--took start-time))))
+
+ ;; Now, simulate typing lang-file and indent it (exercise TAB and RET)
+ (let ((start-time (current-time)))
+ (message "START: %s <indent-via-typing> %s" test-name lang-file)
+ (t-utils--test-indent-typing lang-file lang-file-major-mode
+ expected expected-file
+ line-manipulator)
+ (message "PASS: %s <indent-via-typing> %s %s" test-name lang-file
+ (t-utils--took start-time))))))
+
+ (defun t-utils-test-syntax-table (test-name lang-files)
+ "Test syntax-table on each file in LANG-FILES list.
+ Compare syntax-table of each NAME.EXT in LANG-FILES against
NAME_expected.txt.
+ TEST-NAME is used in messages.
+
+ If NAME_expected.txt does not exist or the syntax-table of NAME.txt doesn't
+ match NAME_expected.txt, NAME_expected.txt~ will be created. You are
+ then instructured to validate the syntax-table and rename NAME_expected.txt~
+ to NAME_expected.txt.
+
+ To add a test for TEST-NAME.el, in it's corresponding TEST-NAME-files/
+ directory, create TEST-NAME-files/NAME.EXT, then run the test. Follow
+ the messages to accept the generated baseline after validating it."
+
+ (dolist (lang-file lang-files)
+ (save-excursion
+ (let ((start-time (current-time)))
+ (message "START: %s %s" test-name lang-file)
+
+ (find-file lang-file)
+ (goto-char (point-min))
+
+ (let* ((got "")
+ (expected-file (replace-regexp-in-string "\\.[^.]+$"
"_expected.txt" lang-file))
+ (got-file (concat expected-file "~"))
+ (expected (when (file-exists-p expected-file)
+ (with-temp-buffer
+ (insert-file-contents-literally expected-file)
+ (buffer-string)))))
+ (while (not (eobp))
+ (when (looking-at "^")
+ (setq got (concat got (format "Line:%d: %s\n"
+ (line-number-at-pos)
+ (buffer-substring-no-properties
(point)
+
(line-end-position))))))
+
+ (let ((char (buffer-substring-no-properties (point) (1+
(point)))))
+ (when (string= char "\n")
+ (setq char "\\n"))
+ (setq got (concat got (format " %2s: %S\n" char (syntax-ppss
(point))))))
+
+ (forward-char))
+
+ (when (not (string= got expected))
+ (let ((coding-system-for-write 'raw-text-unix))
+ (write-region got nil got-file))
+ (when (not expected)
+ (error "Baseline for %s does not exists. \
+ See %s and if it looks good rename it to %s"
+ lang-file got-file expected-file))
+ (error "Baseline for %s does not match, got: %s, expected: %s"
+ lang-file got-file expected-file))
+ (kill-buffer))
+ (message "PASS: %s %s %s" test-name lang-file (t-utils--took
start-time))))))
+
+ (provide 't-utils)
+ ;;; t-utils.el ends here
+
+#+end_src
+
* Issues
- [ ] Building libtree-sitter-matlab.dll from src on Windows produces a DLL
that fails.
diff --git a/matlab-ts-mode.el b/matlab-ts-mode.el
index c1f44d56b6..c6b5b2467d 100644
--- a/matlab-ts-mode.el
+++ b/matlab-ts-mode.el
@@ -650,6 +650,7 @@ expression."
;; Syntax table - think of this as a "language character descriptor". It
tells us what
;; characters belong to word like things giving us movement commands e.g.
C-M-f, matching
;; parens, `show-paren-mode', etc.
+ ;; See: ./tests/test-matlab-ts-mode-syntax-table.el
(set-syntax-table matlab-ts-mode--syntax-table)
(setq-local syntax-propertize-function #'matlab-ts-mode--syntax-propertize)
@@ -682,7 +683,7 @@ expression."
;; Maybe use completion api and complete on each letter?
;; Maybe look at functionSignatures.json?
- ;; Font-lock
+ ;; Font-lock. See: ./tests/test-matlab-ts-mode-font-lock.el
(setq-local treesit-font-lock-level matlab-ts-font-lock-level)
(setq-local treesit-font-lock-settings matlab-ts-mode--font-lock-settings)
(setq-local treesit-font-lock-feature-list '((comment definition)
@@ -690,7 +691,7 @@ expression."
(number bracket delimiter)
(syntax-error)))
- ;; Indent
+ ;; Indent. See: ./tests/test-matlab-ts-mode-indent.el
(setq-local indent-tabs-mode nil) ;; for consistency between Unix and
Windows we don't use TABs.
(setq-local treesit-simple-indent-rules
(if treesit--indent-verbose ;; add debugging print as first
rule?
diff --git a/tests/metest.el b/tests/metest.el
index 8e3d25adea..db67edc7a2 100644
--- a/tests/metest.el
+++ b/tests/metest.el
@@ -39,6 +39,7 @@
(require 'metest-indent-test2)
(require 'metest-imenu)
(require 'metest-imenu-tlc)
+(require 't-utils)
(defun metest-all-syntax-tests ()
"Run all the syntax test cases in this file."
@@ -82,12 +83,9 @@
(when (not (eq system-type 'windows-nt))
(metest-fill-paragraph))
- ;; matlab-ts-mode tests
- (when (>= emacs-major-version 30)
- (require 'test-matlab-ts-mode-font-lock)
- (metest-run 'test-matlab-ts-mode-font-lock)
- (require 'test-matlab-ts-mode-indent)
- (metest-run 'test-matlab-ts-mode-indent)))
+ ;; test-*.el
+ (when (>= emacs-major-version 30) ;; TODO - should we eliminate this version
check?
+ (t-utils-run)))
(defun metest-run (test)
"Run and time TEST."
diff --git a/tests/t-utils.el b/tests/t-utils.el
new file mode 100644
index 0000000000..3bc5584307
--- /dev/null
+++ b/tests/t-utils.el
@@ -0,0 +1,386 @@
+;;; t-utils.el --- Test utilities -*- lexical-binding: t -*-
+;;
+;; Copyright 2025 Free Software Foundation, Inc.
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+
+;;; Commentary:
+;;
+;; Test utilities used by test-*.el files.
+;;
+
+;;; Code:
+
+(require 'cl-seq)
+
+;; Add abs-path of ".." to load-path so we can require packages from above us.
+(let* ((lf (or load-file-name (buffer-file-name (current-buffer))))
+ (d1 (file-name-directory lf))
+ (parent-dir (expand-file-name (file-name-directory (directory-file-name
d1)))))
+ (add-to-list 'load-path parent-dir t))
+
+(defun t-utils-trim ()
+ "Trim trailing whitespace and lines with utf-8-unix encoding."
+ (setq buffer-file-coding-system 'utf-8-unix)
+ (let ((delete-trailing-lines t))
+ (delete-trailing-whitespace (point-min) (point-max))))
+
+(defun t-utils-get-files (subdir base-regexp &optional skip-regexp file-to-use)
+ "Return list of full paths, /path/to/SUBDIR/FILE.
+The FILE basenames returned match BASE-REGEXP.
+Files matching optional SKIP-REGEXP are ignored.
+Optional FILE-TO-USE narrow the list of full paths to that file
+and the result is a list of one file.
+
+For example,
+ (t-utils-get-files \"test-LANGUAGE-ts-mode-files\"
+ \"*\\.lang$\" \"_expected\\.lang$\" file-to-use)
+will return a list of /path/to/test-NAME/*.lang files, skipping
+all *_expected.lang files when file-to-use is nil."
+
+ (let ((files (cl-delete-if (lambda (file)
+ (and skip-regexp
+ (string-match skip-regexp file)))
+ (directory-files subdir t base-regexp))))
+ (when file-to-use
+ (let ((true-file-to-use (file-truename file-to-use)))
+ (when (not (member true-file-to-use files))
+ (if (file-exists-p true-file-to-use)
+ (error "File %s, resolved to %s, is not a valid selection.
+It should be one of %S" file-to-use true-file-to-use files)
+ (error "File %s does not exist" file-to-use)))
+ (setq files (list true-file-to-use))))
+ files))
+
+(defun t-utils-is-treesit-available (language test-name)
+ "Is tree-sitter ready for LANGUAGE?
+If not available a message saying skipping TEST-NAME is displayed."
+ (let ((available (and (>= emacs-major-version 30) ;; treesit package comes
with Emacs 30
+ (progn
+ (require 'treesit)
+ (when (fboundp 'treesit-ready-p)
+ (treesit-ready-p language t))))))
+ (when (not available)
+ (message "skipping-test: %s - %S tree sitter not available." test-name
language))
+ available))
+
+(defun t-utils-run (&optional match)
+ "Run test files in current directory matching regexp, MATCH.
+If optional MATCH is non-nil, only run test file names whose
+non-directory part matches the regexp, MATCH. For example,
+\"^test-foo.*\\\\.el$\" would run tell t-run to run \"test-foo*.el$\"
+files. The default MATCH is \"^test-.*\\\\.el$\""
+ (when (not match)
+ (setq match "^test-.*\\.el$"))
+
+ (dolist (test-file (directory-files "." t match))
+ (when (not (load-file test-file))
+ (error "Failed to load %s" test-file))
+ (let ((test-fun (intern
+ (replace-regexp-in-string "\\.el" ""
(file-name-nondirectory test-file)))))
+ (funcall test-fun))))
+
+(defun t-utils--took (start-time)
+ "Return \"- took N seconds\".
+N is `current-time' minus START-TIME."
+ (format "- took %.2f seconds" (float-time (time-subtract (current-time)
start-time))))
+
+(defun t-utils-test-font-lock (test-name lang-files code-to-face)
+ "Test font-lock using on each lang-file in LANG-FILES list.
+Foreach file in LANG-FILES compare the file against NAME_expected.txt, where
+NAME the file name minus the extension. NAME_expected.txt is of same
+length as the file and has a character for each face setup by font-lock.
+CODE_TO_FACE is an alist where each elment is (CHAR . FACE).
+TEST-NAME is used when displaying messages.
+
+If NAME_expected.txt does not exists or doesn't match the results we
+got, a NAME_expected.txt~ will be generated. After reviewing
+NAME_expected.txt~, you should rename it to NAME_expected.txt or fix
+your code and rerun the test.
+
+For example, suppose our LANG-FILE contains
+ int foo(void) {
+ return 1;
+ }
+our NAME_expected.txt will contain:
+ kkk fffDkkkkD b
+ kkkkkk nD
+ D
+where int and void are keywords, etc. and CODE-TO-FACE contains:
+ \\='((\"b\" . font-lock-bracket-face)
+ (\"d\" . default)
+ (\"D\" . font-lock-delimiter-face)
+ (\"f\" . font-lock-function-name-face)
+ (\"k\" . font-lock-keyword-face)
+ (\"n\" . font-lock-constant-face))"
+
+ (let ((face-to-code (mapcar (lambda (pair)
+ (cons (cdr pair) (car pair)))
+ code-to-face)))
+ (dolist (lang-file lang-files)
+ (save-excursion
+ (let ((start-time (current-time)))
+ (message "START: %s %s" test-name lang-file)
+
+ (when (boundp 'treesit-font-lock-level)
+ (setq treesit-font-lock-level 4))
+
+ (find-file lang-file)
+
+ ;; Force font lock to throw catchable errors.
+ (font-lock-mode 1)
+ (font-lock-flush (point-min) (point-max))
+ (font-lock-ensure (point-min) (point-max))
+
+ (goto-char (point-min))
+ (let* ((got "")
+ (expected-file (replace-regexp-in-string "\\.[^.]+$"
"_expected.txt"
+ lang-file))
+ (got-file (concat expected-file "~"))
+ (expected (when (file-exists-p expected-file)
+ (with-temp-buffer
+ (insert-file-contents-literally expected-file)
+ (buffer-string)))))
+ (while (not (eobp))
+ (let* ((face (if (face-at-point) (face-at-point) 'default))
+ (code (if (looking-at "\\([ \t\n]\\)")
+ (match-string 1)
+ (cdr (assoc face face-to-code)))))
+ (when (not code)
+ (error "Face, %S, is not in code-to-face alist" face))
+ (setq got (concat got code))
+ (forward-char)
+ (when (looking-at "\n")
+ (setq got (concat got "\n"))
+ (forward-char))))
+
+ (when (not (string= got expected))
+ (let ((coding-system-for-write 'raw-text-unix))
+ (write-region got nil got-file))
+ (when (not expected)
+ (error "Baseline for %s does not exists. \
+See %s and if it looks good rename it to %s"
+ lang-file got-file expected-file))
+ (when (= (length got) (length expected))
+ (let* ((diff-idx (1- (compare-strings got nil nil expected nil
nil)))
+ (got-code (substring got diff-idx (1+ diff-idx)))
+ (got-face (cdr (assoc got-code code-to-face)))
+ (expected-code (substring expected diff-idx (1+
diff-idx)))
+ (expected-face (cdr (assoc expected-code
code-to-face))))
+ (error "Baseline for %s does not match, got: %s, expected:
%s. \
+Difference at column %d: got code-to-face (\"%s\" . %S), expected code-to-face
(\"%s\" . %S)"
+ lang-file got-file expected-file
+ diff-idx
+ got-code got-face
+ expected-code expected-face)))
+ (error "Baseline for %s does not match, lengths are different,
got: %s, expected: %s"
+ lang-file got-file expected-file))
+ (kill-buffer))
+ (message "PASS: %s %s %s" test-name lang-file (t-utils--took
start-time)))))))
+
+(defun t-utils--test-indent-typing (lang-file lang-file-mode
+ expected expected-file
+ &optional line-manipulator)
+ "Exercise indent by simulating the creation of LANG-FILE via typing.
+This compares the simulation of typing LANG-FILE against the
+EXPECTED content in EXPECTED-FILE
+
+The typing occurs in a buffer named \"typing__NAME.EXT\" where NAME.EXT
+is the basename of LANG-FILE.
+
+The typing buffer is initialized with the string-trim'd version of the
+non-empty lines of LANG-FILE. If optional LINE-MANIPULATOR function is
+specified, it is called with the typing buffer as the current
+buffer. LINE-MANIPULATOR should only adjust whitespace in the lines. It
+should not add newlines to the buffer. LINE-MANIPULATOR is called from
+within a `save-excursion', so your function doesn't need to do that.
+
+After initializating the typing buffer, it's mode is set to
+LANG-FILE-MODE. Each line is then indented via `indent-for-tab-command'
+and blank lines are inserted by calling `newline'.`"
+
+ (let* ((typing-lang-file-name (concat "typing__" (file-name-nondirectory
lang-file)))
+ (contents (with-temp-buffer
+ (insert-file-contents-literally lang-file)
+ (buffer-substring (point-min) (point-max))))
+ (lines (split-string (string-trim contents) "\n")))
+ (with-current-buffer (get-buffer-create typing-lang-file-name)
+ (erase-buffer)
+ (funcall lang-file-mode)
+
+ ;; Insert the non-empty lines into typing-lang-file-name buffer
+ (dolist (line lines)
+ (setq line (string-trim line))
+ (when (not (string= line ""))
+ (insert line "\n")))
+
+ (goto-char (point-min))
+
+ (when line-manipulator
+ (save-excursion
+ (funcall line-manipulator)))
+
+ ;; Now indent each line and insert the empty ("") lines into
typing-lang-file-buffer
+ ;; as we indent. This exercises the RET and TAB behaviors which cause
different
+ ;; tree-sitter nodes to be provided to the indent engine rules.
+ (while (not (eobp))
+
+ (call-interactively #'indent-for-tab-command) ;; TAB on code just added
+
+ ;; While next line in our original contents is a newline insert "\n"
+ (while (let ((next-line (nth (line-number-at-pos (point)) lines)))
+ (and next-line (string-match-p "^[ \t\r]*$" next-line)))
+ (goto-char (line-end-position))
+ ;; RET to add blank line
+ (call-interactively #'newline)
+ ;; TAB on the same blank line can result in different tree-sitter
nodes than
+ ;; the RET, so exercise that.
+ (call-interactively #'indent-for-tab-command))
+ (forward-line))
+
+ (t-utils-trim)
+
+ (let ((typing-got (buffer-substring (point-min) (point-max))))
+ (set-buffer-modified-p nil)
+ (kill-buffer)
+ (when (not (string= typing-got expected))
+ (let ((coding-system-for-write 'raw-text-unix)
+ (typing-got-file (replace-regexp-in-string "\\.\\([^.]+\\)$"
+ "_typing.\\1~"
+ lang-file)))
+ (write-region typing-got nil typing-got-file)
+ (error "Typing %s line-by-line does not match %s, we got %s"
lang-file expected-file
+ typing-got-file)))))))
+
+(defun t-utils-test-indent (test-name lang-files &optional line-manipulator)
+ "Test indent on each file in LANG-FILES list.
+Compare indent of each NAME.EXT in LANG-FILES against NAME_expected.EXT.
+TEST-NAME is used in messages.
+
+If NAME_expected.EXT does not exist or the indent of NAME.EXT doesn't
+match NAME_expected.txt, NAME_expected.EXT~ will be created. You are
+then instructured to validate the indent and rename NAME_expected.EXT~
+to NAME_expected.EXT.
+
+To add a test for TEST-NAME.el, in it's corresponding TEST-NAME-files/
+directory, create TEST-NAME-files/NAME.EXT, then run the test. Follow
+the messages to accept the generated baseline after validating it.
+
+Two methods are used to indent each file in LANG-FILES,
+ 1. (indent-region (point-min) (point-man))
+ 2. Simulation of typing lang-file to exercise TAB and RET,
+ see `t-utils--test-indent-typing'. In tree-sitter modes, TAB and RET
+ need to be handled and this verifies they are handled.
+
+See `t-utils--test-indent-type' for LINE-MANIPULATOR."
+
+ (dolist (lang-file lang-files)
+ (let* ((expected-file (replace-regexp-in-string "\\.\\([^.]+\\)$"
"_expected.\\1" lang-file))
+ (expected (when (file-exists-p expected-file)
+ (with-temp-buffer
+ (insert-file-contents-literally expected-file)
+ (buffer-string))))
+ lang-file-major-mode)
+
+ ;; Indent lang-file
+ (save-excursion
+ (let ((start-time (current-time)))
+ (message "START: %s <indent-region> %s" test-name lang-file)
+ (find-file lang-file)
+ (setq lang-file-major-mode major-mode)
+ (indent-region (point-min) (point-max))
+ (t-utils-trim)
+ (let ((got (buffer-substring (point-min) (point-max)))
+ (got-file (concat expected-file "~")))
+ (set-buffer-modified-p nil)
+ (kill-buffer)
+ (when (not (string= got expected))
+ (let ((coding-system-for-write 'raw-text-unix))
+ (write-region got nil got-file))
+ (when (not expected)
+ (error "Baseline for %s does not exists - if %s looks good
rename it to %s"
+ lang-file got-file expected-file))
+ (error "Baseline for %s does not match, got: %s, expected: %s"
+ lang-file got-file expected-file)))
+ (message "PASS: %s <indent-region> %s %s" test-name lang-file
+ (t-utils--took start-time))))
+
+ ;; Now, simulate typing lang-file and indent it (exercise TAB and RET)
+ (let ((start-time (current-time)))
+ (message "START: %s <indent-via-typing> %s" test-name lang-file)
+ (t-utils--test-indent-typing lang-file lang-file-major-mode
+ expected expected-file
+ line-manipulator)
+ (message "PASS: %s <indent-via-typing> %s %s" test-name lang-file
+ (t-utils--took start-time))))))
+
+(defun t-utils-test-syntax-table (test-name lang-files)
+ "Test syntax-table on each file in LANG-FILES list.
+Compare syntax-table of each NAME.EXT in LANG-FILES against NAME_expected.txt.
+TEST-NAME is used in messages.
+
+If NAME_expected.txt does not exist or the syntax-table of NAME.txt doesn't
+match NAME_expected.txt, NAME_expected.txt~ will be created. You are
+then instructured to validate the syntax-table and rename NAME_expected.txt~
+to NAME_expected.txt.
+
+To add a test for TEST-NAME.el, in it's corresponding TEST-NAME-files/
+directory, create TEST-NAME-files/NAME.EXT, then run the test. Follow
+the messages to accept the generated baseline after validating it."
+
+ (dolist (lang-file lang-files)
+ (save-excursion
+ (let ((start-time (current-time)))
+ (message "START: %s %s" test-name lang-file)
+
+ (find-file lang-file)
+ (goto-char (point-min))
+
+ (let* ((got "")
+ (expected-file (replace-regexp-in-string "\\.[^.]+$"
"_expected.txt" lang-file))
+ (got-file (concat expected-file "~"))
+ (expected (when (file-exists-p expected-file)
+ (with-temp-buffer
+ (insert-file-contents-literally expected-file)
+ (buffer-string)))))
+ (while (not (eobp))
+ (when (looking-at "^")
+ (setq got (concat got (format "Line:%d: %s\n"
+ (line-number-at-pos)
+ (buffer-substring-no-properties
(point)
+
(line-end-position))))))
+
+ (let ((char (buffer-substring-no-properties (point) (1+ (point)))))
+ (when (string= char "\n")
+ (setq char "\\n"))
+ (setq got (concat got (format " %2s: %S\n" char (syntax-ppss
(point))))))
+
+ (forward-char))
+
+ (when (not (string= got expected))
+ (let ((coding-system-for-write 'raw-text-unix))
+ (write-region got nil got-file))
+ (when (not expected)
+ (error "Baseline for %s does not exists. \
+See %s and if it looks good rename it to %s"
+ lang-file got-file expected-file))
+ (error "Baseline for %s does not match, got: %s, expected: %s"
+ lang-file got-file expected-file))
+ (kill-buffer))
+ (message "PASS: %s %s %s" test-name lang-file (t-utils--took
start-time))))))
+
+(provide 't-utils)
+;;; t-utils.el ends here
diff --git a/tests/test-matlab-ts-mode-font-lock.el
b/tests/test-matlab-ts-mode-font-lock.el
index 2809c29e22..e258c2baa6 100644
--- a/tests/test-matlab-ts-mode-font-lock.el
+++ b/tests/test-matlab-ts-mode-font-lock.el
@@ -25,143 +25,55 @@
;;; Code:
-(require 'cl-macs)
-
-;; Add abs-path of ".." to load-path so we can (require 'matlab-ts-mode)
-(let* ((lf (or load-file-name (buffer-file-name (current-buffer))))
- (d1 (file-name-directory lf))
- (parent-dir (expand-file-name (file-name-directory (directory-file-name
d1)))))
- (add-to-list 'load-path parent-dir t))
-
+(require 't-utils)
(require 'matlab-ts-mode)
-(defun test-matlab-ts-mode-font-lock-files ()
- "Return list of full paths to each test-matlab-ts-mode-font-lock-files/*.m."
- (directory-files "test-matlab-ts-mode-font-lock-files" t "\\.m$"))
-
-(defvar test-matlab-ts-mode-font-lock
- (cons "test-matlab-ts-mode-font-lock" (test-matlab-ts-mode-font-lock-files)))
-
(cl-defun test-matlab-ts-mode-font-lock (&optional m-file)
"Test font-lock using ./test-matlab-ts-mode-font-lock-files/NAME.m.
Compare ./test-matlab-ts-mode-font-lock-files/NAME.m against
./test-matlab-ts-mode-font-lock-files/NAME_expected.txt, where
-NAME_expected.txt is of same length as NAME.m and has a character for
-each face setup by font-lock.
-
-If M-FILE NAME.m is not provided, loop comparing all
+NAME_expected.txt is of same length as NAME.m where each source
+character in NAME.m is replaced with a character code representing the
+font-lock face used for said source character. The mapping is defined
+by the code-to-face alist setup by this function. If M-FILE is not
+provided, loop comparing all
./test-matlab-ts-mode-font-lock-files/NAME.m files.
-For example, given foo.m containing:
- function a = foo
- a = 1;
- end
-we'll have expected that looks like:
- kkkkkkkk v d fff
- d d dd
- kkk
-
-For debugging, you can run with a specified NAME.m,
- M-: (test-matlab-ts-mode-font-lock
\"test-matlab-ts-mode-font-lock-files/NAME.m\")"
-
- (when (or (< emacs-major-version 30)
- (not (progn
- (require 'treesit)
- (when (fboundp 'treesit-ready-p)
- (treesit-ready-p 'matlab t)))))
- (message "skipping-test: test-matlab-ts-mode-font-lock.el - matlab tree
sitter not available.")
- (cl-return-from test-matlab-ts-mode-font-lock))
-
- (let* ((m-files (if m-file
- (progn
- (setq m-file (file-truename m-file))
- (when (not (file-exists-p m-file))
- (error "File %s does not exist" m-file))
- (list m-file))
- (test-matlab-ts-mode-font-lock-files)))
- (code-to-face '(
- ("b" . font-lock-bracket-face)
- ("B" . font-lock-builtin-face)
- ("c" . font-lock-comment-face)
- ("C" . font-lock-comment-delimiter-face)
- ("d" . default)
- ("D" . font-lock-delimiter-face)
- ("f" . font-lock-function-name-face)
- ("h" . font-lock-doc-face) ;; function doc help
comment
- ("H" . matlab-ts-comment-heading-face) ;; %% comment
heading
- ("k" . font-lock-keyword-face)
- ("n" . font-lock-constant-face) ;; numbers
- ("s" . font-lock-string-face)
- ("S" . matlab-ts-string-delimiter-face)
- ("p" . matlab-ts-pragma-face)
- ("P" . font-lock-property-name-face)
- ("t" . font-lock-type-face)
- ("v" . font-lock-variable-name-face)
- ("w" . font-lock-warning-face)
- ))
- (face-to-code (mapcar (lambda (pair)
- (cons (cdr pair) (car pair)))
- code-to-face)))
- (dolist (m-file m-files)
- (save-excursion
- (message "START: test-matlab-ts-mode-font-lock %s" m-file)
-
- (when (boundp 'treesit-font-lock-level)
- (setq treesit-font-lock-level 4))
-
- (find-file m-file)
-
- ;; Force font lock to throw catchable errors.
- (font-lock-mode 1)
- (font-lock-flush (point-min) (point-max))
- (font-lock-ensure (point-min) (point-max))
-
- (goto-char (point-min))
- (let* ((got "")
- (expected-file (replace-regexp-in-string "\\.m$" "_expected.txt"
- m-file))
- (got-file (concat expected-file "~"))
- (expected (when (file-exists-p expected-file)
- (with-temp-buffer
- (insert-file-contents-literally expected-file)
- (buffer-string)))))
- (while (not (eobp))
- (let* ((face (if (face-at-point) (face-at-point) 'default))
- (code (if (looking-at "\\([ \t\n]\\)")
- (match-string 1)
- (cdr (assoc face face-to-code)))))
- (when (not code)
- (error "Face, %S, is not in face-to-code alist" face))
- (setq got (concat got code))
- (forward-char)
- (when (looking-at "\n")
- (setq got (concat got "\n"))
- (forward-char))))
-
- (when (not (string= got expected))
- (let ((coding-system-for-write 'raw-text-unix))
- (write-region got nil got-file))
- (when (not expected)
- (error "Baseline for %s does not exists. \
-See %s and if it looks good rename it to %s"
- m-file got-file expected-file))
- (when (= (length got) (length expected))
- (let* ((diff-idx (1- (compare-strings got nil nil expected nil
nil)))
- (got-code (substring got diff-idx (1+ diff-idx)))
- (got-face (cdr (assoc got-code code-to-face)))
- (expected-code (substring expected diff-idx (1+
diff-idx)))
- (expected-face (cdr (assoc expected-code code-to-face))))
- (error "Baseline for %s does not match, got: %s, expected: %s.
\
-Difference at column %d (got code-to-face \"%s\" . %S, expected code-to-face
\"%s\" . %S"
- m-file got-file expected-file
- diff-idx
- got-code got-face
- expected-code expected-face)))
- (error "Baseline for %s does not match, lengths are different,
got: %s, expected: %s"
- m-file got-file expected-file))
- (kill-buffer)))
- (message "PASS: test-matlab-ts-mode-font-lock %s" m-file)))
- "success")
+To add a test, create
+ ./test-matlab-ts-mode-font-lock-files/NAME.m
+and run this function. The baseline is saved for you as
+ ./test-matlab-ts-mode-font-lock-files/NAME_expected.m~
+after validating it, rename it to
+ ./test-matlab-ts-mode-font-lock-files/NAME_expected.m"
+
+ (let ((test-name "test-matlab-ts-mode-font-lock"))
+ (when (not (t-utils-is-treesit-available 'matlab test-name))
+ (cl-return-from test-matlab-ts-mode-font-lock))
+
+ (let* ((m-files (t-utils-get-files (concat test-name "-files") "\\.m$" nil
m-file))
+ (code-to-face '(
+ ("b" . font-lock-bracket-face)
+ ("B" . font-lock-builtin-face)
+ ("c" . font-lock-comment-face)
+ ("C" . font-lock-comment-delimiter-face)
+ ("d" . default)
+ ("D" . font-lock-delimiter-face)
+ ("f" . font-lock-function-name-face)
+ ("h" . font-lock-doc-face) ;; function doc help
comment
+ ("H" . matlab-ts-comment-heading-face) ;; %%
comment heading
+ ("k" . font-lock-keyword-face)
+ ("n" . font-lock-constant-face) ;; numbers
+ ("s" . font-lock-string-face)
+ ("S" . matlab-ts-string-delimiter-face)
+ ("p" . matlab-ts-pragma-face)
+ ("P" . font-lock-property-name-face)
+ ("t" . font-lock-type-face)
+ ("v" . font-lock-variable-name-face)
+ ("w" . font-lock-warning-face)
+ )))
+ (t-utils-test-font-lock test-name m-files code-to-face))
+ ;; return "success" for M-: (test-matlab-ts-mode-font-lock)
+ "success"))
(provide 'test-matlab-ts-mode-font-lock)
;;; test-matlab-ts-mode-font-lock.el ends here
diff --git a/tests/test-matlab-ts-mode-indent.el
b/tests/test-matlab-ts-mode-indent.el
index f1d744eb74..5c54d5cd42 100644
--- a/tests/test-matlab-ts-mode-indent.el
+++ b/tests/test-matlab-ts-mode-indent.el
@@ -27,140 +27,46 @@
;;; Code:
-(require 'cl-seq)
-
-;; Add abs-path of ".." to load-path so we can (require 'matlab-ts-mode)
-(let* ((lf (or load-file-name (buffer-file-name (current-buffer))))
- (d1 (file-name-directory lf))
- (parent-dir (expand-file-name (file-name-directory (directory-file-name
d1)))))
- (add-to-list 'load-path parent-dir t))
-
+(require 't-utils)
(require 'matlab-ts-mode)
-(setq matlab-ts-mode--indent-assert t)
-
-(defun test-matlab-ts-mode-indent-files ()
- "Return list of full paths to each test-matlab-ts-mode-indent-files/*.m."
- (cl-delete-if (lambda (m-file)
- (string-match "_expected\\.m$" m-file))
- (directory-files "test-matlab-ts-mode-indent-files" t
"\\.m$")))
-
-(defvar test-matlab-ts-mode-indent (cons "test-matlab-ts-mode-indent"
- (test-matlab-ts-mode-indent-files)))
-
-(defun test-matlab-ts-mode-indent--trim ()
- "Trim trailing whitespace and lines."
- (setq buffer-file-coding-system 'utf-8-unix)
- (let ((delete-trailing-lines t))
- (delete-trailing-whitespace (point-min) (point-max))))
-
-(defun test-matlab-ts-mode-indent--typing (m-file expected expected-file)
- "Exercise indent by simulating the creation of M-FILE via typing.
-This compares the simulation of typing M-FILE line by line against
-EXPECTED content in EXPECTED-FILE."
-
- (message "START: test-matlab-ts-mode-indent (typing) %s" m-file)
-
- (let* ((typing-m-file-name (concat "typing__" (file-name-nondirectory
m-file)))
- (contents (with-temp-buffer
- (insert-file-contents-literally m-file)
- (buffer-substring (point-min) (point-max))))
- (lines (split-string (string-trim contents) "\n")))
- (with-current-buffer (get-buffer-create typing-m-file-name)
- (erase-buffer)
- (matlab-ts-mode)
-
- ;; Insert the non-empty lines into typing-m-file-name buffer
- (dolist (line lines)
- (setq line (string-trim line))
- (when (not (string= line ""))
- (insert line "\n")))
-
- ;; Now indent each line and insert the empty ("") lines into
typing-m-file-buffer
- ;; as we indent. This exercises the RET and TAB behaviors which cause
different
- ;; tree-sitter nodes to be provided to the indent engine rules.
- (goto-char (point-min))
- (while (not (eobp))
-
- ;; Workaround
https://github.com/acristoffers/tree-sitter-matlab/issues/32
- (let* ((node (treesit-node-at (point)))
- (parent (and node (treesit-node-parent node))))
- (when (string= (treesit-node-type parent) "ERROR")
- (insert " ")))
-
- (call-interactively #'indent-for-tab-command) ;; TAB on code just added
-
- ;; While next line in our original contents is a newline insert "\n"
- (while (let ((next-line (nth (line-number-at-pos (point)) lines)))
- (and next-line (string-match-p "^[ \t\r]*$" next-line)))
- (goto-char (line-end-position))
- ;; RET to add blank line
- (call-interactively #'newline)
- ;; TAB on the same blank line can result in different tree-sitter
nodes than
- ;; the RET, so exercise that.
- (call-interactively #'indent-for-tab-command))
- (forward-line))
-
- (test-matlab-ts-mode-indent--trim)
-
- (let ((typing-got (buffer-substring (point-min) (point-max))))
- (set-buffer-modified-p nil)
- (kill-buffer)
- (when (not (string= typing-got expected))
- (let ((coding-system-for-write 'raw-text-unix)
- (typing-got-file (replace-regexp-in-string "\\.m$"
"_typing.m~" m-file)))
- (write-region typing-got nil typing-got-file)
- (error "Typing %s line-by-line does not match %s, we got %s"
m-file expected-file
- typing-got-file)))))))
-
-(defun test-matlab-ts-mode-indent (&optional m-file)
+(cl-defun test-matlab-ts-mode-indent (&optional m-file)
"Test indent using ./test-matlab-ts-mode-indent-files/NAME.m.
Compare indent of ./test-matlab-ts-mode-indent-files/NAME.m against
-./test-matlab-ts-mode-indent-files/NAME_expected.m
-
-If M-FILE (NAME.m) is not provided, loop comparing all
-./test-matlab-ts-mode-indent-files/NAME.m files.
-
-For debugging, you can run with a specified NAME.m,
- M-: (test-matlab-ts-mode-font-lock
\"test-matlab-ts-mode-indent-files/NAME.m\")"
-
- (let* ((m-files (if m-file
- (progn
- (setq m-file (file-truename m-file))
- (when (not (file-exists-p m-file))
- (error "File %s does not exist" m-file))
- (list m-file))
- (test-matlab-ts-mode-indent-files))))
- (dolist (m-file m-files)
- (let* ((expected-file (replace-regexp-in-string "\\.m$" "_expected.m"
m-file))
- (expected (when (file-exists-p expected-file)
- (with-temp-buffer
- (insert-file-contents-literally expected-file)
- (buffer-string)))))
-
- (save-excursion
- (message "START: test-matlab-ts-mode-indent %s" m-file)
- (find-file m-file)
- (indent-region (point-min) (point-max))
- (test-matlab-ts-mode-indent--trim)
- (let ((got (buffer-substring (point-min) (point-max)))
- (got-file (concat expected-file "~")))
- (set-buffer-modified-p nil)
- (kill-buffer)
- (when (not (string= got expected))
- (let ((coding-system-for-write 'raw-text-unix))
- (write-region got nil got-file))
- (when (not expected)
- (error "Baseline for %s does not exists - if %s looks good
rename it to %s"
- m-file got-file expected-file))
- (error "Baseline for %s does not match, got: %s, expected: %s"
- m-file got-file expected-file))))
-
- (when expected ;; expected-file exists?
- (test-matlab-ts-mode-indent--typing m-file expected expected-file)))
-
- (message "PASS: test-matlab-ts-mode-indent %s" m-file)))
- "success")
+./test-matlab-ts-mode-indent-files/NAME_expected.m. Indent is done two
+ways as described in `t-utils-test-indent'. If M-FILE is not provided,
+loop comparing all ./test-matlab-ts-mode-indent-files/NAME.m files.
+
+To add a test, create
+ ./test-matlab-ts-mode-indent-files/NAME.m
+and run this function. The baseline is saved for you as
+ ./test-matlab-ts-mode-indent-files/NAME_expected.m~
+after validating it, rename it to
+ ./test-matlab-ts-mode-indent-files/NAME_expected.m"
+
+ (let ((test-name "test-matlab-ts-mode-indent")
+ (matlab-ts-mode--indent-assert t))
+
+ (when (not (t-utils-is-treesit-available 'matlab test-name))
+ (cl-return-from test-matlab-ts-mode-font-lock))
+
+ (let ((m-files (t-utils-get-files (concat test-name "-files") "\\.m$"
+ "_expected\\.m$" ;; skip our
*_expected.m baselines
+ m-file))
+ (line-manipulator (lambda ()
+ ;; Workaround
+ ;;
https://github.com/acristoffers/tree-sitter-matlab/issues/32
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((node (treesit-node-at (point)))
+ (parent (and node (treesit-node-parent
node))))
+ (when (string= (treesit-node-type parent)
"ERROR")
+ (insert " ")))
+ (forward-line)))))
+
+ (t-utils-test-indent test-name m-files line-manipulator)))
+ ;; return "success" for M-: (test-matlab-ts-mode-font-lock)
+ "success")
(provide 'test-matlab-ts-mode-indent)
;;; test-matlab-ts-mode-indent.el ends here
diff --git a/tests/test-matlab-ts-mode-syntax-table.el
b/tests/test-matlab-ts-mode-syntax-table.el
index 4832d1e4a2..ba2923cfef 100644
--- a/tests/test-matlab-ts-mode-syntax-table.el
+++ b/tests/test-matlab-ts-mode-syntax-table.el
@@ -25,89 +25,32 @@
;;; Code:
-(require 'cl-macs)
-
-;; Add abs-path of ".." to load-path so we can (require 'matlab-ts-mode)
-(let* ((lf (or load-file-name (buffer-file-name (current-buffer))))
- (d1 (file-name-directory lf))
- (parent-dir (expand-file-name (file-name-directory (directory-file-name
d1)))))
- (add-to-list 'load-path parent-dir t))
-
+(require 't-utils)
(require 'matlab-ts-mode)
-(defun test-matlab-ts-mode-syntax-table-files ()
- "Return list of full paths to each
test-matlab-ts-mode-syntax-table-files/*.m."
- (directory-files "test-matlab-ts-mode-syntax-table-files" t "\\.m$"))
-
-(defvar test-matlab-ts-mode-syntax-table
- (cons "test-matlab-ts-mode-syntax-table"
(test-matlab-ts-mode-syntax-table-files)))
-
(cl-defun test-matlab-ts-mode-syntax-table (&optional m-file)
"Test syntax-table using ./test-matlab-ts-mode-syntax-table-files/NAME.m.
Compare ./test-matlab-ts-mode-syntax-table-files/NAME.m against
./test-matlab-ts-mode-syntax-table-files/NAME_expected.txt, where
-NAME_expected.txt gives the `syntax-ppss` value of each character in NAME.m
-
-If M-FILE NAME.m is not provided, loop comparing all
-./test-matlab-ts-mode-syntax-table-files/NAME.m files.
-
-For debugging, you can run with a specified NAME.m,
- M-: (test-matlab-ts-mode-syntax-table
\"test-matlab-ts-mode-syntax-table-files/NAME.m\")"
-
- (when (or (< emacs-major-version 30)
- (not (progn
- (require 'treesit)
- (when (fboundp 'treesit-ready-p)
- (treesit-ready-p 'matlab t)))))
- (message "skipping-test: test-matlab-ts-mode-syntax-table.el - tree sitter
not available.")
- (cl-return-from test-matlab-ts-mode-syntax-table))
-
- (let ((m-files (if m-file
- (progn
- (setq m-file (file-truename m-file))
- (when (not (file-exists-p m-file))
- (error "File %s does not exist" m-file))
- (list m-file))
- (test-matlab-ts-mode-syntax-table-files))))
- (dolist (m-file m-files)
- (save-excursion
- (message "START: test-matlab-ts-mode-syntax-table %s" m-file)
-
- (find-file m-file)
- (goto-char (point-min))
-
- (let* ((got "")
- (expected-file (replace-regexp-in-string "\\.m$"
"_expected.txt" m-file))
- (got-file (concat expected-file "~"))
- (expected (when (file-exists-p expected-file)
- (with-temp-buffer
- (insert-file-contents-literally expected-file)
- (buffer-string)))))
- (while (not (eobp))
- (when (looking-at "^")
- (setq got (concat got (format "Line:%d: %s\n"
- (line-number-at-pos)
- (buffer-substring-no-properties
(point)
-
(line-end-position))))))
-
- (let ((char (buffer-substring-no-properties (point) (1+ (point)))))
- (when (string= char "\n")
- (setq char "\\n"))
- (setq got (concat got (format " %2s: %S\n" char (syntax-ppss
(point))))))
-
- (forward-char))
-
- (when (not (string= got expected))
- (let ((coding-system-for-write 'raw-text-unix))
- (write-region got nil got-file))
- (when (not expected)
- (error "Baseline for %s does not exists. \
-See %s and if it looks good rename it to %s"
- m-file got-file expected-file))
- (error "Baseline for %s does not match, got: %s, expected: %s"
- m-file got-file expected-file))
- (kill-buffer)))
- (message "PASS: test-matlab-ts-mode-syntax-table %s" m-file)))
+NAME_expected.txt gives the `syntax-ppss` value of each character in
+NAME.m. If M-FILE is not provided, loop comparing all
+./test-matlab-ts-mode-indent-files/NAME.m files.
+
+To add a test, create
+ ./test-matlab-ts-mode-syntax-table-files/NAME.m
+and run this function. The baseline is saved for you as
+ ./test-matlab-ts-mode-syntax-table-files/NAME_expected.m~
+after validating it, rename it to
+ ./test-matlab-ts-mode-syntax-table-files/NAME_expected.m"
+
+ (let ((test-name "test-matlab-ts-mode-syntax-table"))
+ (when (not (t-utils-is-treesit-available 'matlab test-name))
+ (cl-return-from test-matlab-ts-mode-syntax-table))
+
+ (let ((m-files (t-utils-get-files (concat test-name "-files") "\\.m$" nil
m-file)))
+ (t-utils-test-syntax-table test-name m-files)))
+
+ ;; return "success" for M-: (test-matlab-ts-mode-font-lock)
"success")
(provide 'test-matlab-ts-mode-syntax-table)
