Support more predicates in tree-sitter search functions

Right now we support regexp strings and predicate functions for the
PRED argument. This change adds support for (not ...) (or ...)
and (regexp . pred) predicates.

I still need to find a place to document the supported shapes of a
predicate.

* src/treesit.c (treesit_traverse_validate_predicate): New function.
(treesit_traverse_match_predicate): Support more predicate shapes.
(treesit_search_dfs):
(treesit_search_forward)
(treesit_build_sparse_tree): Fix docstring (unrelated to this change).
(Ftreesit_search_subtree)
(Ftreesit_search_forward)
(Ftreesit_induce_sparse_tree): Use the new function to validate
predicate shape.
(syms_of_treesit): New error Qtreesit_invalid_predicate.

* test/src/treesit-tests.el:
(treesit--ert-search-setup): Add edebug declaration.
(treesit-search-forward-predicate)
(treesit-search-forward-predicate-invalid-predicate): New tests.

1 files changed, 53 insertions, 0 deletions

diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el
index ac5e6f1e08c..26a21c34152 100644
--- a/test/src/treesit-tests.el
+++ b/test/src/treesit-tests.el
@@ -257,6 +257,7 @@
 (defmacro treesit--ert-search-setup (&rest body)
   "Setup macro used by `treesit-search-forward' and friends.
 BODY is the test body."
+  (declare (debug (&rest form)))
   `(with-temp-buffer
      (let (parser root array)
        (progn
@@ -332,6 +333,58 @@ BODY is the test body."
             do (should (equal (treesit-node-text cursor)
                               text)))))
 
+(ert-deftest treesit-search-forward-predicate ()
+  "Test various form of supported predicates in search functions."
+  (skip-unless (treesit-language-available-p 'json))
+  (treesit--ert-search-setup
+   ;; The following tests are adapted from `treesit-search-forward'.
+
+   ;; Test `or'
+   (cl-loop for cursor = (treesit-node-child array 0)
+            then (treesit-search-forward cursor `(or "number" ,(rx "["))
+                                         nil t)
+            for text in '("[" "[" "1" "2" "3"
+                          "[" "4" "5" "6"
+                          "[" "7" "8" "9")
+            while cursor
+            do (should (equal (treesit-node-text cursor) text)))
+   ;; Test `not' and `or'
+   (cl-loop for cursor = (treesit-node-child array 0)
+            then (treesit-search-forward cursor
+                                         `(not (or "number" ,(rx "[")))
+                                         nil t)
+            for text in '("[" "," "," "]"
+                          "[1,2,3]" ","
+                          "," "," "]"
+                          "[4,5,6]" ","
+                          "," "," "]"
+                          "[7,8,9]" "]"
+                          "[[1,2,3], [4,5,6], [7,8,9]]")
+            while cursor
+            do (should (equal (treesit-node-text cursor) text)))
+   ;; Test (regexp . function)
+   (cl-labels ((is-odd (string)
+                 (and (eq 1 (length string))
+                      (cl-oddp (string-to-number string)))))
+     (cl-loop for cursor = (treesit-node-child array 0)
+              then (treesit-search-forward cursor '("number" . is-odd)
+                                           nil t)
+              for text in '("[" "1" "3" "5" "7" "9")
+              while cursor
+              do (should (equal (treesit-node-text cursor) text))))))
+
+(ert-deftest treesit-search-forward-predicate-invalid-predicate ()
+  "Test tree-sitter's ability to detect invalid predicates."
+  (skip-unless (treesit-language-available-p 'json))
+  (treesit--ert-search-setup
+   (dolist (pred '( 1 (not 1) (not "2" "3") (or) (or 1)))
+     (should-error (treesit-search-forward (treesit-node-child array 0)
+                                           pred)
+                   :type 'treesit-invalid-predicate))
+   (should-error (treesit-search-forward (treesit-node-child array 0)
+                                         'not-a-function)
+                 :type 'void-function)))
+
 (ert-deftest treesit-cursor-helper-with-missing-node ()
   "Test treesit_cursor_helper with a missing node."
   (skip-unless (treesit-language-available-p 'json))