;;; tree-sitter-tests.el --- tests for src/tree-sitter.c -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs 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 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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. If not, see .
;;; Code:
(require 'ert)
(require 'tree-sitter)
(ert-deftest tree-sitter-basic-parsing ()
"Test basic parsing routines."
(with-temp-buffer
(let ((parser (tree-sitter-parser-create
(current-buffer) 'tree-sitter-json)))
(should
(eq parser (car tree-sitter-parser-list)))
(should
(equal (tree-sitter-node-string
(tree-sitter-parser-root-node parser))
"(ERROR)"))
(insert "[1,2,3]")
(should
(equal (tree-sitter-node-string
(tree-sitter-parser-root-node parser))
"(document (array (number) (number) (number)))"))
(goto-char (point-min))
(forward-char 3)
(insert "{\"name\": \"Bob\"},")
(should
(equal
(tree-sitter-node-string
(tree-sitter-parser-root-node parser))
"(document (array (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number) (number)))")))))
(ert-deftest tree-sitter-node-api ()
"Tests for node API."
(with-temp-buffer
(let (parser root-node doc-node object-node pair-node)
(progn
(insert "[1,2,{\"name\": \"Bob\"},3]")
(setq parser (tree-sitter-parser-create
(current-buffer) 'tree-sitter-json))
(setq root-node (tree-sitter-parser-root-node
parser)))
;; `tree-sitter-node-type'.
(should (equal "document" (tree-sitter-node-type root-node)))
;; `tree-sitter-node-check'.
(should (eq t (tree-sitter-node-check root-node 'named)))
(should (eq nil (tree-sitter-node-check root-node 'missing)))
(should (eq nil (tree-sitter-node-check root-node 'extra)))
(should (eq nil (tree-sitter-node-check root-node 'has-error)))
;; `tree-sitter-node-child'.
(setq doc-node (tree-sitter-node-child root-node 0))
(should (equal "array" (tree-sitter-node-type doc-node)))
(should (equal (tree-sitter-node-string doc-node)
"(array (number) (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number))"))
;; `tree-sitter-node-child-count'.
(should (eql 9 (tree-sitter-node-child-count doc-node)))
(should (eql 4 (tree-sitter-node-child-count doc-node t)))
;; `tree-sitter-node-field-name-for-child'.
(setq object-node (tree-sitter-node-child doc-node 2 t))
(setq pair-node (tree-sitter-node-child object-node 0 t))
(should (equal "object" (tree-sitter-node-type object-node)))
(should (equal "pair" (tree-sitter-node-type pair-node)))
(should (equal "key"
(tree-sitter-node-field-name-for-child
pair-node 0)))
;; `tree-sitter-node-child-by-field-name'.
(should (equal "(string (string_content))"
(tree-sitter-node-string
(tree-sitter-node-child-by-field-name
pair-node "key"))))
;; `tree-sitter-node-next-sibling'.
(should (equal "(number)"
(tree-sitter-node-string
(tree-sitter-node-next-sibling object-node t))))
(should (equal "(\",\")"
(tree-sitter-node-string
(tree-sitter-node-next-sibling object-node))))
;; `tree-sitter-node-prev-sibling'.
(should (equal "(number)"
(tree-sitter-node-string
(tree-sitter-node-prev-sibling object-node t))))
(should (equal "(\",\")"
(tree-sitter-node-string
(tree-sitter-node-prev-sibling object-node))))
;; `tree-sitter-node-first-child-for-pos'.
(should (equal "(number)"
(tree-sitter-node-string
(tree-sitter-node-first-child-for-pos
doc-node 3 t))))
(should (equal "(\",\")"
(tree-sitter-node-string
(tree-sitter-node-first-child-for-pos
doc-node 3))))
;; `tree-sitter-node-descendant-for-range'.
(should (equal "(\"{\")"
(tree-sitter-node-string
(tree-sitter-node-descendant-for-range
root-node 6 7))))
(should (equal "(object (pair key: (string (string_content)) value: (string (string_content))))"
(tree-sitter-node-string
(tree-sitter-node-descendant-for-range
root-node 6 7 t))))
;; `tree-sitter-node-eq'.
(should (tree-sitter-node-eq root-node root-node))
(should (not (tree-sitter-node-eq root-node doc-node))))))
(ert-deftest tree-sitter-query-api ()
"Tests for query API."
(with-temp-buffer
(let (parser root-node pattern doc-node object-node pair-node)
(progn
(insert "[1,2,{\"name\": \"Bob\"},3]")
(setq parser (tree-sitter-parser-create
(current-buffer) 'tree-sitter-json))
(setq root-node (tree-sitter-parser-root-node
parser)))
(dolist (pattern
'("(string) @string
(pair key: (_) @keyword)
((_) @bob (#match \"^B.b$\" @bob))
(number) @number
((number) @n3 (#equal \"3\" @n3)) "
((string) @string
(pair key: (_) @keyword)
((_) @bob (:match "^B.b$" @bob))
(number) @number
((number) @n3 (:equal "3" @n3)))))
(should
(equal
'((number . "1") (number . "2")
(keyword . "\"name\"")
(string . "\"name\"")
(string . "\"Bob\"")
(bob . "Bob")
(number . "3")
(n3 . "3"))
(mapcar (lambda (entry)
(cons (car entry)
(tree-sitter-node-text
(cdr entry))))
(tree-sitter-query-capture root-node pattern))))
(should
(equal
"(type field: (_) @capture .) ? * + \"return\""
(tree-sitter-expand-query
'((type field: (_) @capture :anchor)
:? :* :+ "return"))))))))
(ert-deftest tree-sitter-narrow ()
"Tests if narrowing works."
(with-temp-buffer
(let (parser root-node pattern doc-node object-node pair-node)
(progn
(insert "xxx[1,{\"name\": \"Bob\"},2,3]xxx")
(narrow-to-region (+ (point-min) 3) (- (point-max) 3))
(setq parser (tree-sitter-parser-create
(current-buffer) 'tree-sitter-json))
(setq root-node (tree-sitter-parser-root-node
parser)))
;; This test is from the basic test.
(should
(equal
(tree-sitter-node-string
(tree-sitter-parser-root-node parser))
"(document (array (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number) (number)))"))
(widen)
(goto-char (point-min))
(insert "ooo")
(should (equal "oooxxx[1,{\"name\": \"Bob\"},2,3]xxx"
(buffer-string)))
(delete-region 10 26)
(should (equal "oooxxx[1,2,3]xxx"
(buffer-string)))
(narrow-to-region (+ (point-min) 6) (- (point-max) 3))
;; This test is also from the basic test.
(should
(equal (tree-sitter-node-string
(tree-sitter-parser-root-node parser))
"(document (array (number) (number) (number)))"))
(widen)
(goto-char (point-max))
(insert "[1,2]")
(should (equal "oooxxx[1,2,3]xxx[1,2]"
(buffer-string)))
(narrow-to-region (- (point-max) 5) (point-max))
(should
(equal (tree-sitter-node-string
(tree-sitter-parser-root-node parser))
"(document (array (number) (number)))"))
(widen)
(goto-char (point-min))
(insert "[1]")
(should (equal "[1]oooxxx[1,2,3]xxx[1,2]"
(buffer-string)))
(narrow-to-region (point-min) (+ (point-min) 3))
(should
(equal (tree-sitter-node-string
(tree-sitter-parser-root-node parser))
"(document (array (number)))")))))
(ert-deftest tree-sitter-range ()
"Tests if range works."
(with-temp-buffer
(let (parser root-node pattern doc-node object-node pair-node)
(progn
(insert "[[1],oooxxx[1,2,3],xxx[1,2]]")
(setq parser (tree-sitter-parser-create
(current-buffer) 'tree-sitter-json))
(setq root-node (tree-sitter-parser-root-node
parser)))
(should-error
(tree-sitter-parser-set-included-ranges
parser '((1 . 6) (5 . 20)))
:type '(tree-sitter-range-invalid))
(tree-sitter-parser-set-included-ranges
parser '((1 . 6) (12 . 20) (23 . 29)))
(should (equal '((1 . 6) (12 . 20) (23 . 29))
(tree-sitter-parser-included-ranges parser)))
(should (equal "(document (array (array (number)) (array (number) (number) (number)) (array (number) (number))))"
(tree-sitter-node-string
(tree-sitter-parser-root-node parser))))
;; TODO: More tests.
)))
(ert-deftest tree-sitter-multi-lang ()
"Tests if parsing multiple language works."
(with-temp-buffer
(let (html css js html-range css-range js-range)
(progn
(insert "")
(setq html (tree-sitter-get-parser-create 'tree-sitter-html))
(setq css (tree-sitter-get-parser-create 'tree-sitter-css))
(setq js (tree-sitter-get-parser-create 'tree-sitter-javascript)))
;; JavaScript.
(setq js-range
(tree-sitter-query-range
'tree-sitter-html
'((script_element (raw_text) @capture))))
(should (equal '((15 . 16)) js-range))
(tree-sitter-parser-set-included-ranges js js-range)
(should (equal "(program (expression_statement (number)))"
(tree-sitter-node-string
(tree-sitter-parser-root-node js))))
;; CSS.
(setq css-range
(tree-sitter-query-range
'tree-sitter-html
'((style_element (raw_text) @capture))))
(should (equal '((32 . 39)) css-range))
(tree-sitter-parser-set-included-ranges css css-range)
(should
(equal "(stylesheet (rule_set (selectors (tag_name)) (block)))"
(tree-sitter-node-string
(tree-sitter-parser-root-node css))))
;; TODO: More tests.
)))
(ert-deftest tree-sitter-parser-supplemental ()
"Supplemental node functions."
;; `tree-sitter-get-parser'.
(with-temp-buffer
(should (equal (tree-sitter-get-parser 'tree-sitter-json) nil)))
;; `tree-sitter-get-parser-create'.
(with-temp-buffer
(should (not (equal (tree-sitter-get-parser-create 'tree-sitter-json)
nil))))
;; `tree-sitter-parse-string'.
(should (equal (tree-sitter-node-string
(tree-sitter-parse-string
"[1,2,{\"name\": \"Bob\"},3]"
'tree-sitter-json))
"(document (array (number) (number) (object (pair key: (string (string_content)) value: (string (string_content)))) (number)))"))
(with-temp-buffer
(let (parser root-node doc-node object-node pair-node)
(progn
(insert "[1,2,{\"name\": \"Bob\"},3]")
(setq parser (tree-sitter-parser-create
(current-buffer) 'tree-sitter-json))
(setq root-node (tree-sitter-parser-root-node
parser))
(setq doc-node (tree-sitter-node-child root-node 0)))
;; `tree-sitter-get-parser'.
(should (not (equal (tree-sitter-get-parser 'tree-sitter-json)
nil)))
;; `tree-sitter-language-at'.
(should (equal (tree-sitter-language-at (point))
'tree-sitter-json))
;; `tree-sitter-set-ranges', `tree-sitter-get-ranges'.
(tree-sitter-set-ranges 'tree-sitter-json
'((1 . 2)))
(should (equal (tree-sitter-get-ranges 'tree-sitter-json)
'((1 . 2)))))))
(ert-deftest tree-sitter-node-supplemental ()
"Supplemental node functions."
(let (parser root-node doc-node array-node)
(progn
(insert "[1,2,{\"name\": \"Bob\"},3]")
(setq parser (tree-sitter-parser-create
(current-buffer) 'tree-sitter-json))
(setq root-node (tree-sitter-parser-root-node
parser))
(setq doc-node (tree-sitter-node-child root-node 0)))
;; `tree-sitter-node-buffer'.
(should (equal (tree-sitter-node-buffer root-node)
(current-buffer)))
;; `tree-sitter-node-language'.
(should (eq (tree-sitter-node-language root-node)
'tree-sitter-json))
;; `tree-sitter-node-at'.
(should (equal (tree-sitter-node-string
(tree-sitter-node-at 1 2 'tree-sitter-json))
"(\"[\")"))
;; `tree-sitter-buffer-root-node'.
(should (tree-sitter-node-eq
(tree-sitter-buffer-root-node 'tree-sitter-json)
root-node))
;; `tree-sitter-filter-child'.
(should (equal (mapcar
(lambda (node)
(tree-sitter-node-type node))
(tree-sitter-filter-child
doc-node (lambda (node)
(tree-sitter-node-check node 'named))))
'("number" "number" "object" "number")))
;; `tree-sitter-node-text'.
(should (equal (tree-sitter-node-text doc-node)
"[1,2,{\"name\": \"Bob\"},3]"))
;; `tree-sitter-node-index'.
(should (eq (tree-sitter-node-index doc-node)
0))
;; TODO:
;; `tree-sitter-parent-until'
;; `tree-sitter-parent-while'
;; `tree-sitter-node-children'
;; `tree-sitter-node-field-name'
))
;; TODO
;; - Functions in tree-sitter.el
;; - tree-sitter-load-name-override-list
(provide 'tree-sitter-tests)
;;; tree-sitter-tests.el ends here